home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / RxRichEd.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  155.3 KB  |  4,953 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12. unit RxRichEd;
  13.  
  14. {$I RX.INC}
  15.  
  16. {.$DEFINE RICHEDIT_VER_10}
  17.  
  18. {$R-}
  19.  
  20. interface
  21.  
  22. uses Windows, {$IFDEF RX_D3} ActiveX, ComObj {$ELSE} Ole2, OleAuto {$ENDIF},
  23.   CommCtrl, Messages, SysUtils, Classes, Controls, Forms, Graphics, StdCtrls,
  24.   Dialogs, RichEdit, Menus, ComCtrls;
  25.  
  26. type
  27.   TRichEditVersion = 1..3;
  28.  
  29. {$IFNDEF RX_D3}
  30.  
  31.   TCharFormat2A = record
  32.     cbSize: UINT;
  33.     dwMask: DWORD;
  34.     dwEffects: DWORD;
  35.     yHeight: Longint;
  36.     yOffset: Longint;
  37.     crTextColor: TColorRef;
  38.     bCharSet: Byte;
  39.     bPitchAndFamily: Byte;
  40.     szFaceName: array[0..LF_FACESIZE - 1] of AnsiChar;
  41.     { new fields in version 2.0 }
  42.     wWeight: Word;                   { Font weight (LOGFONT value)             }
  43.     sSpacing: Smallint;              { Amount to space between letters         }
  44.     crBackColor: TColorRef;          { Background color                        }
  45.     lid: LCID;                       { Locale ID                               }
  46.     dwReserved: DWORD;               { Reserved. Must be 0                     }
  47.     sStyle: Smallint;                { Style handle                            }
  48.     wKerning: Word;                  { Twip size above which to kern char pair }
  49.     bUnderlineType: Byte;            { Underline type                          }
  50.     bAnimation: Byte;                { Animated text like marching ants        }
  51.     bRevAuthor: Byte;                { Revision author index                   }
  52.     bReserved1: Byte;
  53.   end;
  54.   TCharFormat2 = TCharFormat2A;
  55.  
  56.   TParaFormat2 = record
  57.     cbSize: UINT;
  58.     dwMask: DWORD;
  59.     wNumbering: Word;
  60.     wReserved: Word;
  61.     dxStartIndent: Longint;
  62.     dxRightIndent: Longint;
  63.     dxOffset: Longint;
  64.     wAlignment: Word;
  65.     cTabCount: Smallint;
  66.     rgxTabs: array [0..MAX_TAB_STOPS - 1] of Longint;
  67.     { new fields in version 2.0 }
  68.     dySpaceBefore: Longint;     { Vertical spacing before paragraph      }
  69.     dySpaceAfter: Longint;      { Vertical spacing after paragraph       }
  70.     dyLineSpacing: Longint;     { Line spacing depending on Rule         }
  71.     sStyle: Smallint;           { Style handle                           }
  72.     bLineSpacingRule: Byte;     { Rule for line spacing (see tom.doc)    }
  73.     bCRC: Byte;                 { Reserved for CRC for rapid searching   }
  74.     wShadingWeight: Word;       { Shading in hundredths of a per cent    }
  75.     wShadingStyle: Word;        { Nibble 0: style, 1: cfpat, 2: cbpat    }
  76.     wNumberingStart: Word;      { Starting value for numbering           }
  77.     wNumberingStyle: Word;      { Alignment, roman/arabic, (), ), ., etc.}
  78.     wNumberingTab: Word;        { Space bet 1st indent and 1st-line text }
  79.     wBorderSpace: Word;         { Space between border and text (twips)  }
  80.     wBorderWidth: Word;         { Border pen width (twips)               }
  81.     wBorders: Word;             { Byte 0: bits specify which borders     }
  82.                                 { Nibble 2: border style, 3: color index }
  83.   end;
  84.  
  85. {$ENDIF RX_D3}
  86.  
  87. {$IFDEF RX_D5}
  88.   TCharFormat2 = TCharFormat2A;
  89. {$ENDIF}
  90.  
  91. type
  92.   TRxCustomRichEdit = class;
  93.  
  94. { TRxTextAttributes }
  95.  
  96.   TRxAttributeType = (atDefaultText, atSelected, atWord);
  97.   TRxConsistentAttribute = (caBold, caColor, caFace, caItalic, caSize,
  98.     caStrikeOut, caUnderline, caProtected, caOffset, caHidden, caLink,
  99.     caBackColor, caDisabled, caWeight, caSubscript, caRevAuthor);
  100.   TRxConsistentAttributes = set of TRxConsistentAttribute;
  101.   TSubscriptStyle = (ssNone, ssSubscript, ssSuperscript);
  102.   TUnderlineType = (utNone, utSolid, utWord, utDouble, utDotted, utWave);
  103.  
  104.   TRxTextAttributes = class(TPersistent)
  105.   private
  106.     RichEdit: TRxCustomRichEdit;
  107.     FType: TRxAttributeType;
  108.     procedure AssignFont(Font: TFont);
  109.     procedure GetAttributes(var Format: TCharFormat2);
  110. {$IFNDEF VER90}
  111.     function GetCharset: TFontCharset;
  112.     procedure SetCharset(Value: TFontCharset);
  113. {$ENDIF}
  114.     function GetSubscriptStyle: TSubscriptStyle;
  115.     procedure SetSubscriptStyle(Value: TSubscriptStyle);
  116.     function GetBackColor: TColor;
  117.     function GetColor: TColor;
  118.     function GetConsistentAttributes: TRxConsistentAttributes;
  119.     function GetHeight: Integer;
  120.     function GetHidden: Boolean;
  121.     function GetDisabled: Boolean;
  122.     function GetLink: Boolean;
  123.     function GetName: TFontName;
  124.     function GetOffset: Integer;
  125.     function GetPitch: TFontPitch;
  126.     function GetProtected: Boolean;
  127.     function GetRevAuthorIndex: Byte;
  128.     function GetSize: Integer;
  129.     function GetStyle: TFontStyles;
  130.     function GetUnderlineType: TUnderlineType;
  131.     procedure SetAttributes(var Format: TCharFormat2);
  132.     procedure SetBackColor(Value: TColor);
  133.     procedure SetColor(Value: TColor);
  134.     procedure SetDisabled(Value: Boolean);
  135.     procedure SetHeight(Value: Integer);
  136.     procedure SetHidden(Value: Boolean);
  137.     procedure SetLink(Value: Boolean);
  138.     procedure SetName(Value: TFontName);
  139.     procedure SetOffset(Value: Integer);
  140.     procedure SetPitch(Value: TFontPitch);
  141.     procedure SetProtected(Value: Boolean);
  142.     procedure SetRevAuthorIndex(Value: Byte);
  143.     procedure SetSize(Value: Integer);
  144.     procedure SetStyle(Value: TFontStyles);
  145.     procedure SetUnderlineType(Value: TUnderlineType);
  146.   protected
  147.     procedure InitFormat(var Format: TCharFormat2);
  148.     procedure AssignTo(Dest: TPersistent); override;
  149.   public
  150.     constructor Create(AOwner: TRxCustomRichEdit; AttributeType: TRxAttributeType);
  151.     procedure Assign(Source: TPersistent); override;
  152. {$IFNDEF VER90}
  153.     property Charset: TFontCharset read GetCharset write SetCharset;
  154. {$ENDIF}
  155.     property BackColor: TColor read GetBackColor write SetBackColor;
  156.     property Color: TColor read GetColor write SetColor;
  157.     property ConsistentAttributes: TRxConsistentAttributes read GetConsistentAttributes;
  158.     property Disabled: Boolean read GetDisabled write SetDisabled;
  159.     property Hidden: Boolean read GetHidden write SetHidden;
  160.     property Link: Boolean read GetLink write SetLink;
  161.     property Name: TFontName read GetName write SetName;
  162.     property Offset: Integer read GetOffset write SetOffset;
  163.     property Pitch: TFontPitch read GetPitch write SetPitch;
  164.     property Protected: Boolean read GetProtected write SetProtected;
  165.     property RevAuthorIndex: Byte read GetRevAuthorIndex write SetRevAuthorIndex;
  166.     property SubscriptStyle: TSubscriptStyle read GetSubscriptStyle write SetSubscriptStyle;
  167.     property Size: Integer read GetSize write SetSize;
  168.     property Style: TFontStyles read GetStyle write SetStyle;
  169.     property Height: Integer read GetHeight write SetHeight;
  170.     property UnderlineType: TUnderlineType read GetUnderlineType write SetUnderlineType;
  171.   end;
  172.  
  173. { TRxParaAttributes }
  174.  
  175.   TRxNumbering = (nsNone, nsBullet, nsArabicNumbers, nsLoCaseLetter,
  176.     nsUpCaseLetter, nsLoCaseRoman, nsUpCaseRoman);
  177.   TRxNumberingStyle = (nsParenthesis, nsPeriod, nsEnclosed, nsSimple);
  178.   TParaAlignment = (paLeftJustify, paRightJustify, paCenter, paJustify);
  179.   TLineSpacingRule = (lsSingle, lsOneAndHalf, lsDouble, lsSpecifiedOrMore,
  180.     lsSpecified, lsMultiple);
  181.   THeadingStyle = 0..9;
  182.   TParaTableStyle = (tsNone, tsTableRow, tsTableCellEnd, tsTableCell);
  183.  
  184.   TRxParaAttributes = class(TPersistent)
  185.   private
  186.     RichEdit: TRxCustomRichEdit;
  187.     procedure GetAttributes(var Paragraph: TParaFormat2);
  188.     function GetAlignment: TParaAlignment;
  189.     function GetFirstIndent: Longint;
  190.     function GetHeadingStyle: THeadingStyle;
  191.     function GetLeftIndent: Longint;
  192.     function GetRightIndent: Longint;
  193.     function GetSpaceAfter: Longint;
  194.     function GetSpaceBefore: Longint;
  195.     function GetLineSpacing: Longint;
  196.     function GetLineSpacingRule: TLineSpacingRule;
  197.     function GetNumbering: TRxNumbering;
  198.     function GetNumberingStyle: TRxNumberingStyle;
  199.     function GetNumberingTab: Word;
  200.     function GetTab(Index: Byte): Longint;
  201.     function GetTabCount: Integer;
  202.     function GetTableStyle: TParaTableStyle;
  203.     procedure SetAlignment(Value: TParaAlignment);
  204.     procedure SetAttributes(var Paragraph: TParaFormat2);
  205.     procedure SetFirstIndent(Value: Longint);
  206.     procedure SetHeadingStyle(Value: THeadingStyle);
  207.     procedure SetLeftIndent(Value: Longint);
  208.     procedure SetRightIndent(Value: Longint);
  209.     procedure SetSpaceAfter(Value: Longint);
  210.     procedure SetSpaceBefore(Value: Longint);
  211.     procedure SetLineSpacing(Value: Longint);
  212.     procedure SetLineSpacingRule(Value: TLineSpacingRule);
  213.     procedure SetNumbering(Value: TRxNumbering);
  214.     procedure SetNumberingStyle(Value: TRxNumberingStyle);
  215.     procedure SetNumberingTab(Value: Word);
  216.     procedure SetTab(Index: Byte; Value: Longint);
  217.     procedure SetTabCount(Value: Integer);
  218.     procedure SetTableStyle(Value: TParaTableStyle);
  219.   protected
  220.     procedure InitPara(var Paragraph: TParaFormat2);
  221.     procedure AssignTo(Dest: TPersistent); override;
  222.   public
  223.     constructor Create(AOwner: TRxCustomRichEdit);
  224.     procedure Assign(Source: TPersistent); override;
  225.     property Alignment: TParaAlignment read GetAlignment write SetAlignment;
  226.     property FirstIndent: Longint read GetFirstIndent write SetFirstIndent;
  227.     property HeadingStyle: THeadingStyle read GetHeadingStyle write SetHeadingStyle;
  228.     property LeftIndent: Longint read GetLeftIndent write SetLeftIndent;
  229.     property LineSpacing: Longint read GetLineSpacing write SetLineSpacing;
  230.     property LineSpacingRule: TLineSpacingRule read GetLineSpacingRule write SetLineSpacingRule;
  231.     property Numbering: TRxNumbering read GetNumbering write SetNumbering;
  232.     property NumberingStyle: TRxNumberingStyle read GetNumberingStyle write SetNumberingStyle;
  233.     property NumberingTab: Word read GetNumberingTab write SetNumberingTab;
  234.     property RightIndent: Longint read GetRightIndent write SetRightIndent;
  235.     property SpaceAfter: Longint read GetSpaceAfter write SetSpaceAfter;
  236.     property SpaceBefore: Longint read GetSpaceBefore write SetSpaceBefore;
  237.     property Tab[Index: Byte]: Longint read GetTab write SetTab;
  238.     property TabCount: Integer read GetTabCount write SetTabCount;
  239.     property TableStyle: TParaTableStyle read GetTableStyle write SetTableStyle;
  240.   end;
  241.  
  242. { TOEMConversion }
  243.  
  244.   TOEMConversion = class(TConversion)
  245.   public
  246.     function ConvertReadStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
  247.     function ConvertWriteStream(Stream: TStream; Buffer: PChar; BufSize: Integer): Integer; override;
  248.   end;
  249.  
  250. { TRxCustomRichEdit }
  251.  
  252.   TUndoName = (unUnknown, unTyping, unDelete, unDragDrop, unCut, unPaste);
  253.   TRichSearchType = (stWholeWord, stMatchCase, stBackward, stSetSelection);
  254.   TRichSearchTypes = set of TRichSearchType;
  255.   TRichSelection = (stText, stObject, stMultiChar, stMultiObject);
  256.   TRichSelectionType = set of TRichSelection;
  257.   TRichLangOption = (rlAutoKeyboard, rlAutoFont, rlImeCancelComplete,
  258.     rlImeAlwaysSendNotify);
  259.   TRichLangOptions = set of TRichLangOption;
  260.   TRichStreamFormat = (sfDefault, sfRichText, sfPlainText);
  261.   TRichStreamMode = (smSelection, smPlainRtf, smNoObjects, smUnicode);
  262.   TRichStreamModes = set of TRichStreamMode;
  263.   TRichEditURLClickEvent = procedure(Sender: TObject; const URLText: string;
  264.     Button: TMouseButton) of object;
  265.   TRichEditProtectChangeEx = procedure(Sender: TObject; const Message: TMessage;
  266.     StartPos, EndPos: Integer; var AllowChange: Boolean) of object;
  267.   TRichEditFindErrorEvent = procedure(Sender: TObject; const FindText: string) of object;
  268. {$IFDEF RX_D3}
  269.   TRichEditFindCloseEvent = procedure(Sender: TObject; Dialog: TFindDialog) of object;
  270. {$ENDIF}
  271.  
  272.   PRichConversionFormat = ^TRichConversionFormat;
  273.   TRichConversionFormat = record
  274.     ConversionClass: TConversionClass;
  275.     Extension: string;
  276.     PlainText: Boolean;
  277.     Next: PRichConversionFormat;
  278.   end;
  279.  
  280.   TRxCustomRichEdit = class(TCustomMemo)
  281.   private
  282.     FHideScrollBars: Boolean;
  283.     FSelectionBar: Boolean;
  284.     FAutoURLDetect: Boolean;
  285.     FWordSelection: Boolean;
  286.     FPlainText: Boolean;
  287.     FSelAttributes: TRxTextAttributes;
  288.     FDefAttributes: TRxTextAttributes;
  289.     FWordAttributes: TRxTextAttributes;
  290.     FParagraph: TRxParaAttributes;
  291.     FOldParaAlignment: TParaAlignment;
  292.     FScreenLogPixels: Integer;
  293.     FUndoLimit: Integer;
  294.     FRichEditStrings: TStrings;
  295.     FMemStream: TMemoryStream;
  296.     FHideSelection: Boolean;
  297.     FLangOptions: TRichLangOptions;
  298.     FModified: Boolean;
  299.     FLinesUpdating: Boolean;
  300.     FPageRect: TRect;
  301.     FClickRange: TCharRange;
  302.     FClickBtn: TMouseButton;
  303.     FFindDialog: TFindDialog;
  304.     FReplaceDialog: TReplaceDialog;
  305.     FLastFind: TFindDialog;
  306.     FAllowObjects: Boolean;
  307.     FCallback: TObject;
  308.     FRichEditOle: IUnknown;
  309.     FPopupVerbMenu: TPopupMenu;
  310.     FTitle: string;
  311.     FAutoVerbMenu: Boolean;
  312. {$IFDEF RX_D3}
  313.     FAllowInPlace: Boolean;
  314. {$ENDIF}
  315.     FDefaultConverter: TConversionClass;
  316.     FOnSelChange: TNotifyEvent;
  317.     FOnResizeRequest: TRichEditResizeEvent;
  318.     FOnProtectChange: TRichEditProtectChange;
  319.     FOnProtectChangeEx: TRichEditProtectChangeEx;
  320.     FOnSaveClipboard: TRichEditSaveClipboard;
  321.     FOnURLClick: TRichEditURLClickEvent;
  322.     FOnTextNotFound: TRichEditFindErrorEvent;
  323. {$IFDEF RX_D3}
  324.     FOnCloseFindDialog: TRichEditFindCloseEvent;
  325. {$ENDIF}
  326.     function GetAutoURLDetect: Boolean;
  327.     function GetWordSelection: Boolean;
  328.     function GetLangOptions: TRichLangOptions;
  329.     function GetCanRedo: Boolean;
  330.     function GetCanPaste: Boolean;
  331. {$IFNDEF RX_V110}
  332.     function GetCanUndo: Boolean;
  333. {$ENDIF}
  334.     function GetRedoName: TUndoName;
  335.     function GetUndoName: TUndoName;
  336.     function GetStreamFormat: TRichStreamFormat;
  337.     function GetStreamMode: TRichStreamModes;
  338.     function GetSelectionType: TRichSelectionType;
  339.     procedure PopupVerbClick(Sender: TObject);
  340.     procedure ObjectPropsClick(Sender: TObject);
  341.     procedure CloseObjects;
  342.     procedure UpdateHostNames;
  343.     procedure SetAllowObjects(Value: Boolean);
  344.     procedure SetStreamFormat(Value: TRichStreamFormat);
  345.     procedure SetStreamMode(Value: TRichStreamModes);
  346.     procedure SetAutoURLDetect(Value: Boolean);
  347.     procedure SetWordSelection(Value: Boolean);
  348.     procedure SetHideScrollBars(Value: Boolean);
  349.     procedure SetHideSelection(Value: Boolean);
  350.     procedure SetTitle(const Value: string);
  351.     procedure SetLangOptions(Value: TRichLangOptions);
  352.     procedure SetRichEditStrings(Value: TStrings);
  353.     procedure SetDefAttributes(Value: TRxTextAttributes);
  354.     procedure SetSelAttributes(Value: TRxTextAttributes);
  355.     procedure SetWordAttributes(Value: TRxTextAttributes);
  356.     procedure SetSelectionBar(Value: Boolean);
  357.     procedure SetUndoLimit(Value: Integer);
  358.     procedure UpdateTextModes(Plain: Boolean);
  359.     procedure AdjustFindDialogPosition(Dialog: TFindDialog);
  360.     procedure SetupFindDialog(Dialog: TFindDialog; const SearchStr,
  361.       ReplaceStr: string);
  362.     function FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean;
  363.     function GetCanFindNext: Boolean;
  364.     procedure FindDialogFind(Sender: TObject);
  365.     procedure ReplaceDialogReplace(Sender: TObject);
  366. {$IFDEF RX_D3}
  367.     procedure FindDialogClose(Sender: TObject);
  368.     procedure SetUIActive(Active: Boolean);
  369.     procedure CMDocWindowActivate(var Message: TMessage); message CM_DOCWINDOWACTIVATE;
  370.     procedure CMUIDeactivate(var Message: TMessage); message CM_UIDEACTIVATE;
  371. {$ENDIF}
  372. {$IFDEF RX_D4}
  373.     procedure CMBiDiModeChanged(var Message: TMessage); message CM_BIDIMODECHANGED;
  374. {$ENDIF}
  375.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  376.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  377.     procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  378.     procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL;
  379.     procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
  380.     procedure WMMouseMove(var Message: TMessage); message WM_MOUSEMOVE;
  381.     procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  382.     procedure WMSetCursor(var Message: TWMSetCursor); message WM_SETCURSOR;
  383.     procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
  384. {$IFDEF RX_D5}
  385.     procedure WMRButtonUp(var Message: TMessage); message WM_RBUTTONUP;
  386. {$ENDIF}
  387.   protected
  388.     procedure CreateParams(var Params: TCreateParams); override;
  389.     procedure CreateWindowHandle(const Params: TCreateParams); override;
  390.     procedure CreateWnd; override;
  391.     procedure DestroyWnd; override;
  392.     function GetPopupMenu: TPopupMenu; override;
  393.     procedure TextNotFound(Dialog: TFindDialog); virtual;
  394.     procedure RequestSize(const Rect: TRect); virtual;
  395.     procedure SelectionChange; dynamic;
  396.     function ProtectChange(const Message: TMessage; StartPos,
  397.       EndPos: Integer): Boolean; dynamic;
  398.     function SaveClipboard(NumObj, NumChars: Integer): Boolean; dynamic;
  399.     procedure URLClick(const URLText: string; Button: TMouseButton); dynamic;
  400.     procedure SetPlainText(Value: Boolean); virtual;
  401. {$IFDEF RX_D3}
  402.     procedure CloseFindDialog(Dialog: TFindDialog); virtual;
  403.     procedure DoSetMaxLength(Value: Integer); override;
  404.     function GetSelLength: Integer; override;
  405.     function GetSelStart: Integer; override;
  406.     function GetSelText: string; override;
  407.     procedure SetSelLength(Value: Integer); override;
  408.     procedure SetSelStart(Value: Integer); override;
  409.     property AllowInPlace: Boolean read FAllowInPlace write FAllowInPlace default True;
  410. {$ENDIF}
  411.     property AllowObjects: Boolean read FAllowObjects write SetAllowObjects default True;
  412.     property AutoURLDetect: Boolean read GetAutoURLDetect write SetAutoURLDetect default True;
  413.     property AutoVerbMenu: Boolean read FAutoVerbMenu write FAutoVerbMenu default True;
  414.     property HideSelection: Boolean read FHideSelection write SetHideSelection default True;
  415.     property HideScrollBars: Boolean read FHideScrollBars
  416.       write SetHideScrollBars default True;
  417.     property Title: string read FTitle write SetTitle;
  418.     property LangOptions: TRichLangOptions read GetLangOptions write SetLangOptions default [rlAutoFont];
  419.     property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
  420.     property PlainText: Boolean read FPlainText write SetPlainText default False;
  421.     property SelectionBar: Boolean read FSelectionBar write SetSelectionBar default True;
  422.     property StreamFormat: TRichStreamFormat read GetStreamFormat write SetStreamFormat default sfDefault;
  423.     property StreamMode: TRichStreamModes read GetStreamMode write SetStreamMode default [];
  424.     property UndoLimit: Integer read FUndoLimit write SetUndoLimit default 100;
  425.     property WordSelection: Boolean read GetWordSelection write SetWordSelection default True;
  426.     property ScrollBars default ssBoth;
  427.     property TabStop default True;
  428.     property OnSaveClipboard: TRichEditSaveClipboard read FOnSaveClipboard
  429.       write FOnSaveClipboard;
  430.     property OnSelectionChange: TNotifyEvent read FOnSelChange write FOnSelChange;
  431.     property OnProtectChange: TRichEditProtectChange read FOnProtectChange
  432.       write FOnProtectChange; { obsolete }
  433.     property OnProtectChangeEx: TRichEditProtectChangeEx read FOnProtectChangeEx
  434.       write FOnProtectChangeEx;
  435.     property OnResizeRequest: TRichEditResizeEvent read FOnResizeRequest
  436.       write FOnResizeRequest;
  437.     property OnURLClick: TRichEditURLClickEvent read FOnURLClick write FOnURLClick;
  438.     property OnTextNotFound: TRichEditFindErrorEvent read FOnTextNotFound write FOnTextNotFound;
  439. {$IFDEF RX_D3}
  440.     property OnCloseFindDialog: TRichEditFindCloseEvent read FOnCloseFindDialog
  441.       write FOnCloseFindDialog;
  442. {$ENDIF}
  443.   public
  444.     constructor Create(AOwner: TComponent); override;
  445.     destructor Destroy; override;
  446.     procedure Clear; {$IFDEF RX_D3} override; {$ENDIF}
  447.     procedure SetSelection(StartPos, EndPos: Longint; ScrollCaret: Boolean);
  448.     function GetSelection: TCharRange;
  449.     function GetTextRange(StartPos, EndPos: Longint): string;
  450.     function LineFromChar(CharIndex: Integer): Integer;
  451.     function GetLineIndex(LineNo: Integer): Integer;
  452.     function GetLineLength(CharIndex: Integer): Integer;
  453.     function WordAtCursor: string;
  454.     function FindText(const SearchStr: string;
  455.       StartPos, Length: Integer; Options: TRichSearchTypes): Integer;
  456.     function GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  457.       {$IFDEF RX_D3} override; {$ENDIF}
  458.     function GetCaretPos: TPoint; {$IFDEF RX_V110} override; {$ENDIF}
  459.     function GetCharPos(CharIndex: Integer): TPoint;
  460.     function InsertObjectDialog: Boolean;
  461.     function ObjectPropertiesDialog: Boolean;
  462.     function PasteSpecialDialog: Boolean;
  463.     function FindDialog(const SearchStr: string): TFindDialog;
  464.     function ReplaceDialog(const SearchStr, ReplaceStr: string): TReplaceDialog;
  465.     function FindNext: Boolean;
  466.     procedure Print(const Caption: string); virtual;
  467.     class procedure RegisterConversionFormat(const AExtension: string;
  468.       APlainText: Boolean; AConversionClass: TConversionClass);
  469.     procedure ClearUndo;
  470.     procedure Redo;
  471.     procedure StopGroupTyping;
  472.     property CanFindNext: Boolean read GetCanFindNext;
  473.     property CanRedo: Boolean read GetCanRedo;
  474.     property CanPaste: Boolean read GetCanPaste;
  475. {$IFNDEF RX_V110}
  476.     procedure Undo;
  477.     property CanUndo: Boolean read GetCanUndo;
  478.     property CaretPos: TPoint read GetCaretPos;
  479. {$ENDIF}
  480.     property RedoName: TUndoName read GetRedoName;
  481.     property UndoName: TUndoName read GetUndoName;
  482.     property DefaultConverter: TConversionClass read FDefaultConverter
  483.       write FDefaultConverter;
  484.     property DefAttributes: TRxTextAttributes read FDefAttributes write SetDefAttributes;
  485.     property SelAttributes: TRxTextAttributes read FSelAttributes write SetSelAttributes;
  486.     property WordAttributes: TRxTextAttributes read FWordAttributes write SetWordAttributes;
  487.     property PageRect: TRect read FPageRect write FPageRect;
  488.     property Paragraph: TRxParaAttributes read FParagraph;
  489.     property SelectionType: TRichSelectionType read GetSelectionType;
  490.   end;
  491.  
  492.   TRxRichEdit = class(TRxCustomRichEdit)
  493.   published
  494.     property Align;
  495.     property Alignment;
  496.     property AutoURLDetect;
  497.     property AutoVerbMenu;
  498.     property AllowObjects;
  499. {$IFDEF RX_D3}
  500.     property AllowInPlace;
  501. {$ENDIF}
  502. {$IFDEF RX_D4}
  503.     property Anchors;
  504.     property BiDiMode;
  505.     property BorderWidth;
  506.     property DragKind;
  507. {$ENDIF}
  508.     property BorderStyle;
  509.     property Color;
  510.     property Ctl3D;
  511.     property DragCursor;
  512.     property DragMode;
  513.     property Enabled;
  514.     property Font;
  515.     property HideSelection;
  516.     property HideScrollBars;
  517.     property Title;
  518. {$IFNDEF VER90}
  519.     property ImeMode;
  520.     property ImeName;
  521. {$ENDIF}
  522. {$IFDEF RX_D4}
  523.     property Constraints;
  524.     property ParentBiDiMode;
  525. {$ENDIF}
  526.     property LangOptions;
  527.     property Lines;
  528.     property MaxLength;
  529.     property ParentColor;
  530.     property ParentCtl3D;
  531.     property ParentFont;
  532.     property ParentShowHint;
  533.     property PlainText;
  534.     property PopupMenu;
  535.     property ReadOnly;
  536.     property ScrollBars;
  537.     property SelectionBar;
  538.     property ShowHint;
  539.     property StreamFormat;
  540.     property StreamMode;
  541.     property TabOrder;
  542.     property TabStop;
  543.     property UndoLimit;
  544.     property Visible;
  545.     property WantTabs;
  546.     property WantReturns;
  547.     property WordSelection;
  548.     property WordWrap;
  549.     property OnChange;
  550.     property OnDblClick;
  551.     property OnDragDrop;
  552.     property OnDragOver;
  553. {$IFDEF RX_D5}
  554.     property OnContextPopup;
  555. {$ENDIF}
  556. {$IFDEF RX_D4}
  557.     property OnEndDock;
  558.     property OnStartDock;
  559. {$ENDIF}
  560.     property OnEndDrag;
  561.     property OnEnter;
  562.     property OnExit;
  563.     property OnKeyDown;
  564.     property OnKeyPress;
  565.     property OnKeyUp;
  566.     property OnMouseDown;
  567.     property OnMouseMove;
  568.     property OnMouseUp;
  569. {$IFDEF RX_D4}
  570.     property OnMouseWheel;
  571.     property OnMouseWheelDown;
  572.     property OnMouseWheelUp;
  573. {$ENDIF}
  574.     property OnProtectChange; { obsolete }
  575.     property OnProtectChangeEx;
  576.     property OnResizeRequest;
  577.     property OnSaveClipboard;
  578.     property OnSelectionChange;
  579.     property OnStartDrag;
  580.     property OnTextNotFound;
  581. {$IFDEF RX_D3}
  582.     property OnCloseFindDialog;
  583. {$ENDIF}
  584.     property OnURLClick;
  585.   end;
  586.  
  587. var
  588.   RichEditVersion: TRichEditVersion;
  589.  
  590. implementation
  591.  
  592. uses Printers, ComStrs, OleConst, OleDlg {$IFDEF RX_D3}, OleCtnrs {$ENDIF},
  593.   MaxMin;
  594.  
  595. const
  596.   RTFConversionFormat: TRichConversionFormat = (
  597.     ConversionClass: TConversion;
  598.     Extension: 'rtf';
  599.     PlainText: False;
  600.     Next: nil);
  601.   TextConversionFormat: TRichConversionFormat = (
  602.     ConversionClass: TConversion;
  603.     Extension: 'txt';
  604.     PlainText: True;
  605.     Next: @RTFConversionFormat);
  606.  
  607. var
  608.   ConversionFormatList: PRichConversionFormat = @TextConversionFormat;
  609.  
  610. const
  611.   RichEdit10ModuleName = 'RICHED32.DLL';
  612.   RichEdit20ModuleName = 'RICHED20.DLL';
  613. {$IFNDEF RX_D3}
  614.   RICHEDIT_CLASSA      = 'RichEdit20A';     { Richedit 2.0 Window Class }
  615.   RICHEDIT_CLASSW      = 'RichEdit20W';     { Richedit 2.0 Unicode }
  616.   RICHEDIT_CLASS10A    = 'RICHEDIT';        { Richedit 1.0 }
  617.   RICHEDIT_CLASS       = RICHEDIT_CLASSA;
  618. {$ENDIF}
  619.  
  620. {$IFNDEF RX_D3}
  621.  
  622. const
  623.   EM_SETUNDOLIMIT                     = WM_USER + 82; 
  624.   EM_REDO                             = WM_USER + 84; 
  625.   EM_CANREDO                          = WM_USER + 85;
  626.   EM_GETUNDONAME                      = WM_USER + 86; 
  627.   EM_GETREDONAME                      = WM_USER + 87; 
  628.   EM_STOPGROUPTYPING                  = WM_USER + 88; 
  629.   EM_SETTEXTMODE                      = WM_USER + 89; 
  630.   EM_GETTEXTMODE                      = WM_USER + 90; 
  631.  
  632. { for use with EM_GET/SETTEXTMODE }
  633.  
  634.   TM_PLAINTEXT                       = 1; 
  635.   TM_RICHTEXT                        = 2;     { default behavior }
  636.   TM_SINGLELEVELUNDO                 = 4;
  637.   TM_MULTILEVELUNDO                  = 8;     { default behavior }
  638.   TM_SINGLECODEPAGE                  = 16; 
  639.   TM_MULTICODEPAGE                   = 32;    { default behavior }
  640.  
  641.   EM_AUTOURLDETECT                    = WM_USER + 91; 
  642.   EM_GETAUTOURLDETECT                 = WM_USER + 92;
  643.   EM_SETPALETTE                       = WM_USER + 93;
  644.   EM_GETTEXTEX                        = WM_USER + 94; 
  645.   EM_GETTEXTLENGTHEX                  = WM_USER + 95; 
  646.  
  647.   EM_SETLANGOPTIONS                   = WM_USER + 120;
  648.   EM_GETLANGOPTIONS                   = WM_USER + 121;
  649.   EM_GETIMECOMPMODE                   = WM_USER + 122;
  650.  
  651. { Options for EM_SETLANGOPTIONS and EM_GETLANGOPTIONS }
  652.  
  653.   IMF_AUTOKEYBOARD            = $0001;
  654.   IMF_AUTOFONT                = $0002;
  655.   IMF_IMECANCELCOMPLETE       = $0004;  { high completes the comp string when aborting, low cancels. }
  656.   IMF_IMEALWAYSSENDNOTIFY     = $0008;
  657.  
  658. { New notifications }
  659.  
  660.   EN_OLEOPFAILED                      = $0709;
  661.   EN_OBJECTPOSITIONS                  = $070A;
  662.   EN_LINK                             = $070B;
  663.   EN_DRAGDROPDONE                     = $070C;
  664.  
  665. { Event notification masks }
  666.  
  667.   ENM_SCROLLEVENTS                    = $00000008;
  668.   ENM_DRAGDROPDONE                    = $00000010;
  669.   ENM_LANGCHANGE                      = $01000000; 
  670.   ENM_OBJECTPOSITIONS                 = $02000000; 
  671.   ENM_LINK                            = $04000000;
  672.  
  673. { New edit control styles }
  674.  
  675.   ES_NOOLEDRAGDROP                    = $00000008; 
  676.  
  677. const
  678.   CFM_LINK = $00000020;  { Exchange hyperlink extension }
  679.  
  680.   CFM_EFFECTS = CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_COLOR or
  681.     CFM_STRIKEOUT or CFE_PROTECTED or CFM_LINK;
  682.   CFM_ALL = CFM_EFFECTS or CFM_SIZE or CFM_FACE or CFM_OFFSET or CFM_CHARSET;
  683.   PFM_ALL = PFM_STARTINDENT or PFM_RIGHTINDENT or PFM_OFFSET or
  684.     PFM_ALIGNMENT or PFM_TABSTOPS or PFM_NUMBERING or PFM_OFFSETINDENT;
  685.  
  686. { New masks and effects -- a parenthesized asterisk indicates that
  687.    the data is stored by RichEdit2.0, but not displayed }
  688.  
  689.   CFM_SMALLCAPS               = $0040;                  { (*)    }
  690.   CFM_ALLCAPS                 = $0080;                  { (*)    }
  691.   CFM_HIDDEN                  = $0100;                  { (*)    }
  692.   CFM_OUTLINE                 = $0200;                  { (*)    }
  693.   CFM_SHADOW                  = $0400;                  { (*)    }
  694.   CFM_EMBOSS                  = $0800;                  { (*)    }
  695.   CFM_IMPRINT                 = $1000;                  { (*)    }
  696.   CFM_DISABLED                = $2000;
  697.   CFM_REVISED                 = $4000;
  698.  
  699.   CFM_BACKCOLOR               = $04000000; 
  700.   CFM_LCID                    = $02000000; 
  701.   CFM_UNDERLINETYPE           = $00800000;              { (*)    }
  702.   CFM_WEIGHT                  = $00400000;
  703.   CFM_SPACING                 = $00200000;              { (*)    }
  704.   CFM_KERNING                 = $00100000;              { (*)    }
  705.   CFM_STYLE                   = $00080000;              { (*)    }
  706.   CFM_ANIMATION               = $00040000;              { (*)    }
  707.   CFM_REVAUTHOR               = $00008000; 
  708.  
  709.   CFE_LINK                    = $00000020;
  710.   CFE_AUTOCOLOR               = $40000000;   { NOTE: this corresponds to CFM_COLOR, }
  711.                                              { which controls it }
  712.   CFE_SUBSCRIPT               = $00010000;   { Superscript and subscript are }
  713.   CFE_SUPERSCRIPT             = $00020000;   { mutually exclusive            }
  714.  
  715.   CFM_SUBSCRIPT               = CFE_SUBSCRIPT or CFE_SUPERSCRIPT;
  716.   CFM_SUPERSCRIPT             = CFM_SUBSCRIPT;
  717.  
  718.   CFM_EFFECTS2 = CFM_EFFECTS or CFM_DISABLED or CFM_SMALLCAPS or CFM_ALLCAPS or 
  719.     CFM_HIDDEN  or CFM_OUTLINE or CFM_SHADOW or CFM_EMBOSS or 
  720.     CFM_IMPRINT or CFM_DISABLED or CFM_REVISED or 
  721.     CFM_SUBSCRIPT or CFM_SUPERSCRIPT or CFM_BACKCOLOR;
  722.  
  723.   CFM_ALL2 = CFM_ALL or CFM_EFFECTS2 or CFM_BACKCOLOR or CFM_LCID or 
  724.     CFM_UNDERLINETYPE or CFM_WEIGHT or CFM_REVAUTHOR or 
  725.     CFM_SPACING or CFM_KERNING or CFM_STYLE or CFM_ANIMATION;
  726.  
  727.   CFE_SMALLCAPS               = CFM_SMALLCAPS; 
  728.   CFE_ALLCAPS                 = CFM_ALLCAPS; 
  729.   CFE_HIDDEN                  = CFM_HIDDEN; 
  730.   CFE_OUTLINE                 = CFM_OUTLINE;
  731.   CFE_SHADOW                  = CFM_SHADOW; 
  732.   CFE_EMBOSS                  = CFM_EMBOSS;
  733.   CFE_IMPRINT                 = CFM_IMPRINT;
  734.   CFE_DISABLED                = CFM_DISABLED;
  735.   CFE_REVISED                 = CFM_REVISED;
  736.  
  737.   CFE_AUTOBACKCOLOR           = CFM_BACKCOLOR; 
  738.  
  739. { Underline types }
  740.  
  741.   CFU_CF1UNDERLINE            = $FF;    { map charformat's bit underline to CF2. }
  742.   CFU_INVERT                  = $FE;    { For IME composition fake a selection.  }
  743.   CFU_UNDERLINEDOTTED         = $4;     { (*) displayed as ordinary underline    }
  744.   CFU_UNDERLINEDOUBLE         = $3;     { (*) displayed as ordinary underline    }
  745.   CFU_UNDERLINEWORD           = $2;     { (*) displayed as ordinary underline    }
  746.   CFU_UNDERLINE               = $1; 
  747.   CFU_UNDERLINENONE           = 0; 
  748.  
  749. { PARAFORMAT 2.0 masks and effects }
  750.  
  751. const
  752.   PFM_SPACEBEFORE                     = $00000040;
  753.   PFM_SPACEAFTER                      = $00000080;
  754.   PFM_LINESPACING                     = $00000100; 
  755.   PFM_STYLE                           = $00000400;
  756.   PFM_BORDER                          = $00000800;      { (*)    }
  757.   PFM_SHADING                         = $00001000;      { (*)    }
  758.   PFM_NUMBERINGSTYLE                  = $00002000;      { (*)    }
  759.   PFM_NUMBERINGTAB                    = $00004000;      { (*)    }
  760.   PFM_NUMBERINGSTART                  = $00008000;      { (*)    }
  761.  
  762.   PFM_RTLPARA                         = $00010000; 
  763.   PFM_KEEP                            = $00020000;      { (*)    }
  764.   PFM_KEEPNEXT                        = $00040000;      { (*)    }
  765.   PFM_PAGEBREAKBEFORE                 = $00080000;      { (*)    }
  766.   PFM_NOLINENUMBER                    = $00100000;      { (*)    }
  767.   PFM_NOWIDOWCONTROL                  = $00200000;      { (*)    }
  768.   PFM_DONOTHYPHEN                     = $00400000;      { (*)    }
  769.   PFM_SIDEBYSIDE                      = $00800000;      { (*)    }
  770.  
  771.   PFM_TABLE                           = $C0000000;      { (*)    }
  772.  
  773. { Note: PARAFORMAT has no effects }
  774.  
  775.   PFM_EFFECTS = PFM_RTLPARA or PFM_KEEP or PFM_KEEPNEXT or PFM_TABLE or
  776.     PFM_PAGEBREAKBEFORE or PFM_NOLINENUMBER or 
  777.     PFM_NOWIDOWCONTROL or PFM_DONOTHYPHEN or PFM_SIDEBYSIDE or PFM_TABLE; 
  778.  
  779.   PFM_ALL2 = PFM_ALL or PFM_EFFECTS or PFM_SPACEBEFORE or PFM_SPACEAFTER or 
  780.     PFM_LINESPACING or PFM_STYLE or PFM_SHADING or PFM_BORDER or 
  781.     PFM_NUMBERINGTAB or PFM_NUMBERINGSTART or PFM_NUMBERINGSTYLE;
  782.  
  783.   PFE_RTLPARA                         = PFM_RTLPARA              shr 16; 
  784.   PFE_KEEP                            = PFM_KEEP                 shr 16;    { (*)    }
  785.   PFE_KEEPNEXT                        = PFM_KEEPNEXT             shr 16;    { (*)    }
  786.   PFE_PAGEBREAKBEFORE                 = PFM_PAGEBREAKBEFORE      shr 16;    { (*)    }
  787.   PFE_NOLINENUMBER                    = PFM_NOLINENUMBER         shr 16;    { (*)    }
  788.   PFE_NOWIDOWCONTROL                  = PFM_NOWIDOWCONTROL       shr 16;    { (*)    }
  789.   PFE_DONOTHYPHEN                     = PFM_DONOTHYPHEN          shr 16;    { (*)    }
  790.   PFE_SIDEBYSIDE                      = PFM_SIDEBYSIDE           shr 16;    { (*)    }
  791.  
  792.   PFE_TABLEROW                        = $C000;          { These 3 options are mutually   }
  793.   PFE_TABLECELLEND                    = $8000;          {  exclusive and each imply      }
  794.   PFE_TABLECELL                       = $4000;          {  that para is part of a table  }
  795.  
  796.   PFA_JUSTIFY                         = 4;      { New paragraph-alignment option 2.0 (*) }
  797.  
  798. const
  799.   SF_UNICODE = $0010;  { Unicode file of some kind }
  800.  
  801. type
  802.   TFindTextExA = record
  803.     chrg: TCharRange;
  804.     lpstrText: PAnsiChar;
  805.     chrgText: TCharRange;
  806.   end;
  807.  
  808.   TObjectPositions = packed record 
  809.     nmhdr: TNMHdr;
  810.     cObjectCount: Longint;
  811.     pcpPositions: PLongint;
  812.   end;
  813.  
  814.   TENLink = record 
  815.     nmhdr: TNMHdr;
  816.     msg: UINT;
  817.     wParam: WPARAM;
  818.     lParam: LPARAM;
  819.     chrg: TCharRange;
  820.   end;
  821.  
  822.   TENOleOpFailed = packed record 
  823.     nmhdr: TNMHdr;
  824.     iob: Longint;
  825.     lOper: Longint;
  826.     hr: HRESULT;
  827.   end;
  828.  
  829. { flags for the GETTEXTLENGTHEX data structure }
  830.  
  831. const
  832.   GTL_DEFAULT         = 0;      { do the default (return # of chars)        }
  833.   GTL_USECRLF         = 1;      { compute answer using CRLFs for paragraphs }
  834.   GTL_PRECISE         = 2;      { compute a precise answer                  }
  835.   GTL_CLOSE           = 4;      { fast computation of a "close" answer      }
  836.   GTL_NUMCHARS        = 8;      { return the number of characters           }
  837.   GTL_NUMBYTES        = 16;     { return the number of _bytes_              }
  838.  
  839. { EM_GETTEXTLENGTHEX info; this struct is passed in the wparam of the msg }
  840.  
  841. type
  842.   TGetTextLengthEx = record 
  843.     flags: DWORD;              { flags (see GTL_XXX defines)  }
  844.     codepage: UINT;            { code page for translation    }
  845.   end;
  846.  
  847. const
  848.   OLEOP_DOVERB = 1;
  849.  
  850. {$ENDIF RX_D3}
  851.  
  852. const
  853.   FT_DOWN = 1;
  854.  
  855. type
  856.   PENLink = ^TENLink;
  857.   PENOleOpFailed = ^TENOleOpFailed;
  858.   TFindTextEx = TFindTextExA;
  859.  
  860.   TTextRangeA = record
  861.     chrg: TCharRange;
  862.     lpstrText: PAnsiChar;
  863.   end;
  864.   TTextRangeW = record
  865.     chrg: TCharRange;
  866.     lpstrText: PWideChar;
  867.   end;
  868.   TTextRange = TTextRangeA;
  869.  
  870. {$IFDEF RX_D3}
  871. function ResStr(const Ident: string): string;
  872. begin
  873.   Result := Ident;
  874. end;
  875. {$ELSE}
  876. function ResStr(Ident: Cardinal): string;
  877. begin
  878.   Result := LoadStr(Ident);
  879. end;
  880. {$ENDIF}
  881.  
  882. { TRxTextAttributes }
  883.  
  884. const
  885.   AttrFlags: array[TRxAttributeType] of Word = (0, SCF_SELECTION,
  886.     SCF_WORD or SCF_SELECTION);
  887.  
  888. constructor TRxTextAttributes.Create(AOwner: TRxCustomRichEdit;
  889.   AttributeType: TRxAttributeType);
  890. begin
  891.   inherited Create;
  892.   RichEdit := AOwner;
  893.   FType := AttributeType;
  894. end;
  895.  
  896. procedure TRxTextAttributes.InitFormat(var Format: TCharFormat2);
  897. begin
  898.   FillChar(Format, SizeOf(Format), 0);
  899.   if RichEditVersion >= 2 then Format.cbSize := SizeOf(Format)
  900.   else Format.cbSize := SizeOf(TCharFormat);
  901. end;
  902.  
  903. function TRxTextAttributes.GetConsistentAttributes: TRxConsistentAttributes;
  904. var
  905.   Format: TCharFormat2;
  906. begin
  907.   Result := [];
  908.   if RichEdit.HandleAllocated and (FType <> atDefaultText) then begin
  909.     InitFormat(Format);
  910.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT,
  911.       AttrFlags[FType], LPARAM(@Format));
  912.     with Format do begin
  913.       if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
  914.       if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
  915.       if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
  916.       if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
  917.       if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
  918.       if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
  919.       if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
  920.       if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
  921.       if (dwMask and CFM_OFFSET) <> 0 then Include(Result, caOffset);
  922.       if (dwMask and CFM_HIDDEN) <> 0 then Include(result, caHidden);
  923.       if RichEditVersion >= 2 then begin
  924.         if (dwMask and CFM_LINK) <> 0 then Include(Result, caLink);
  925.         if (dwMask and CFM_BACKCOLOR) <> 0 then Include(Result, caBackColor);
  926.         if (dwMask and CFM_DISABLED) <> 0 then Include(Result, caDisabled);
  927.         if (dwMask and CFM_WEIGHT) <> 0 then Include(Result, caWeight);
  928.         if (dwMask and CFM_SUBSCRIPT) <> 0 then Include(Result, caSubscript);
  929.         if (dwMask and CFM_REVAUTHOR) <> 0 then Include(Result, caRevAuthor);
  930.       end;
  931.     end;
  932.   end;
  933. end;
  934.  
  935. procedure TRxTextAttributes.GetAttributes(var Format: TCharFormat2);
  936. begin
  937.   InitFormat(Format);
  938.   if RichEdit.HandleAllocated then
  939.     SendMessage(RichEdit.Handle, EM_GETCHARFORMAT, AttrFlags[FType],
  940.       LPARAM(@Format));
  941. end;
  942.  
  943. procedure TRxTextAttributes.SetAttributes(var Format: TCharFormat2);
  944. begin
  945.   if RichEdit.HandleAllocated then
  946.     SendMessage(RichEdit.Handle, EM_SETCHARFORMAT, AttrFlags[FType],
  947.       LPARAM(@Format));
  948. end;
  949.  
  950. {$IFNDEF VER90}
  951. function TRxTextAttributes.GetCharset: TFontCharset;
  952. var
  953.   Format: TCharFormat2;
  954. begin
  955.   GetAttributes(Format);
  956.   Result := Format.bCharset;
  957. end;
  958.  
  959. procedure TRxTextAttributes.SetCharset(Value: TFontCharset);
  960. var
  961.   Format: TCharFormat2;
  962. begin
  963.   InitFormat(Format);
  964.   with Format do
  965.   begin
  966.     dwMask := CFM_CHARSET;
  967.     bCharSet := Value;
  968.   end;
  969.   SetAttributes(Format);
  970. end;
  971. {$ENDIF}
  972.  
  973. function TRxTextAttributes.GetProtected: Boolean;
  974. var
  975.   Format: TCharFormat2;
  976. begin
  977.   GetAttributes(Format);
  978.   with Format do
  979.     Result := (dwEffects and CFE_PROTECTED) <> 0;
  980. end;
  981.  
  982. procedure TRxTextAttributes.SetProtected(Value: Boolean);
  983. var
  984.   Format: TCharFormat2;
  985. begin
  986.   InitFormat(Format);
  987.   with Format do begin
  988.     dwMask := CFM_PROTECTED;
  989.     if Value then dwEffects := CFE_PROTECTED;
  990.   end;
  991.   SetAttributes(Format);
  992. end;
  993.  
  994. function TRxTextAttributes.GetLink: Boolean;
  995. var
  996.   Format: TCharFormat2;
  997. begin
  998.   Result := False;
  999.   if RichEditVersion < 2 then Exit;
  1000.   GetAttributes(Format);
  1001.   with Format do Result := (dwEffects and CFE_LINK) <> 0;
  1002. end;
  1003.  
  1004. procedure TRxTextAttributes.SetLink(Value: Boolean);
  1005. var
  1006.   Format: TCharFormat2;
  1007. begin
  1008.   if RichEditVersion < 2 then Exit;
  1009.   InitFormat(Format);
  1010.   with Format do begin
  1011.     dwMask := CFM_LINK;
  1012.     if Value then dwEffects := CFE_LINK;
  1013.   end;
  1014.   SetAttributes(Format);
  1015. end;
  1016.  
  1017. function TRxTextAttributes.GetRevAuthorIndex: Byte;
  1018. var
  1019.   Format: TCharFormat2;
  1020. begin
  1021.   GetAttributes(Format);
  1022.   Result := Format.bRevAuthor;
  1023. end;
  1024.  
  1025. procedure TRxTextAttributes.SetRevAuthorIndex(Value: Byte);
  1026. var
  1027.   Format: TCharFormat2;
  1028. begin
  1029.   if RichEditVersion < 2 then Exit;
  1030.   InitFormat(Format);
  1031.   with Format do begin
  1032.     dwMask := CFM_REVAUTHOR;
  1033.     bRevAuthor := Value;
  1034.   end;
  1035.   SetAttributes(Format);
  1036. end;
  1037.  
  1038. function TRxTextAttributes.GetHidden: Boolean;
  1039. var
  1040.   Format: TCharFormat2;
  1041. begin
  1042.   Result := False;
  1043.   if RichEditVersion < 2 then Exit;
  1044.   GetAttributes(Format);
  1045.   Result := Format.dwEffects and CFE_HIDDEN <> 0;
  1046. end;
  1047.  
  1048. procedure TRxTextAttributes.SetHidden(Value: Boolean);
  1049. var
  1050.   Format: TCharFormat2;
  1051. begin
  1052.   if RichEditVersion < 2 then Exit;
  1053.   InitFormat(Format);
  1054.   with Format do begin
  1055.     dwMask := CFM_HIDDEN;
  1056.     if Value then dwEffects := CFE_HIDDEN;
  1057.   end;
  1058.   SetAttributes(Format);
  1059. end;
  1060.  
  1061. function TRxTextAttributes.GetDisabled: Boolean;
  1062. var
  1063.   Format: TCharFormat2;
  1064. begin
  1065.   Result := False;
  1066.   if RichEditVersion < 2 then Exit;
  1067.   GetAttributes(Format);
  1068.   Result := Format.dwEffects and CFE_DISABLED <> 0;
  1069. end;
  1070.  
  1071. procedure TRxTextAttributes.SetDisabled(Value: Boolean);
  1072. var
  1073.   Format: TCharFormat2;
  1074. begin
  1075.   if RichEditVersion < 2 then Exit;
  1076.   InitFormat(Format);
  1077.   with Format do begin
  1078.     dwMask := CFM_DISABLED;
  1079.     if Value then dwEffects := CFE_DISABLED;
  1080.   end;
  1081.   SetAttributes(Format);
  1082. end;
  1083.  
  1084. function TRxTextAttributes.GetColor: TColor;
  1085. var
  1086.   Format: TCharFormat2;
  1087. begin
  1088.   GetAttributes(Format);
  1089.   with Format do
  1090.     if (dwEffects and CFE_AUTOCOLOR) <> 0 then Result := clWindowText
  1091.     else Result := crTextColor;
  1092. end;
  1093.  
  1094. procedure TRxTextAttributes.SetColor(Value: TColor);
  1095. var
  1096.   Format: TCharFormat2;
  1097. begin
  1098.   InitFormat(Format);
  1099.   with Format do begin
  1100.     dwMask := CFM_COLOR;
  1101.     if (Value = clWindowText) or (Value = clDefault) then
  1102.       dwEffects := CFE_AUTOCOLOR
  1103.     else crTextColor := ColorToRGB(Value);
  1104.   end;
  1105.   SetAttributes(Format);
  1106. end;
  1107.  
  1108. function TRxTextAttributes.GetBackColor: TColor;
  1109. var
  1110.   Format: TCharFormat2;
  1111. begin
  1112.   if RichEditVersion < 2 then begin
  1113.     Result := clWindow;
  1114.     Exit;
  1115.   end;
  1116.   GetAttributes(Format);
  1117.   with Format do
  1118.     if (dwEffects and CFE_AUTOBACKCOLOR) <> 0 then Result := clWindow
  1119.     else Result := crBackColor;
  1120. end;
  1121.  
  1122. procedure TRxTextAttributes.SetBackColor(Value: TColor);
  1123. var
  1124.   Format: TCharFormat2;
  1125. begin
  1126.   if RichEditVersion < 2 then Exit;
  1127.   InitFormat(Format);
  1128.   with Format do begin
  1129.     dwMask := CFM_BACKCOLOR;
  1130.     if (Value = clWindow) or (Value = clDefault) then
  1131.       dwEffects := CFE_AUTOBACKCOLOR
  1132.     else crBackColor := ColorToRGB(Value);
  1133.   end;
  1134.   SetAttributes(Format);
  1135. end;
  1136.  
  1137. function TRxTextAttributes.GetName: TFontName;
  1138. var
  1139.   Format: TCharFormat2;
  1140. begin
  1141.   GetAttributes(Format);
  1142.   Result := Format.szFaceName;
  1143. end;
  1144.  
  1145. procedure TRxTextAttributes.SetName(Value: TFontName);
  1146. var
  1147.   Format: TCharFormat2;
  1148. begin
  1149.   InitFormat(Format);
  1150.   with Format do begin
  1151.     dwMask := CFM_FACE;
  1152.     StrPLCopy(szFaceName, Value, SizeOf(szFaceName));
  1153.   end;
  1154.   SetAttributes(Format);
  1155. end;
  1156.  
  1157. function TRxTextAttributes.GetStyle: TFontStyles;
  1158. var
  1159.   Format: TCharFormat2;
  1160. begin
  1161.   Result := [];
  1162.   GetAttributes(Format);
  1163.   with Format do begin
  1164.     if (dwEffects and CFE_BOLD) <> 0 then Include(Result, fsBold);
  1165.     if (dwEffects and CFE_ITALIC) <> 0 then Include(Result, fsItalic);
  1166.     if (dwEffects and CFE_UNDERLINE) <> 0 then Include(Result, fsUnderline);
  1167.     if (dwEffects and CFE_STRIKEOUT) <> 0 then Include(Result, fsStrikeOut);
  1168.   end;
  1169. end;
  1170.  
  1171. procedure TRxTextAttributes.SetStyle(Value: TFontStyles);
  1172. var
  1173.   Format: TCharFormat2;
  1174. begin
  1175.   InitFormat(Format);
  1176.   with Format do begin
  1177.     dwMask := CFM_BOLD or CFM_ITALIC or CFM_UNDERLINE or CFM_STRIKEOUT;
  1178.     if fsBold in Value then dwEffects := dwEffects or CFE_BOLD;
  1179.     if fsItalic in Value then dwEffects := dwEffects or CFE_ITALIC;
  1180.     if fsUnderline in Value then dwEffects := dwEffects or CFE_UNDERLINE;
  1181.     if fsStrikeOut in Value then dwEffects := dwEffects or CFE_STRIKEOUT;
  1182.   end;
  1183.   SetAttributes(Format);
  1184. end;
  1185.  
  1186. function TRxTextAttributes.GetUnderlineType: TUnderlineType;
  1187. var
  1188.   Format: TCharFormat2;
  1189. begin
  1190.   Result := utNone;
  1191.   if RichEditVersion < 2 then Exit;
  1192.   GetAttributes(Format);
  1193.   with Format do begin
  1194.     if (dwEffects and CFE_UNDERLINE <> 0) and
  1195.       (dwMask and CFM_UNDERLINETYPE = CFM_UNDERLINETYPE) then
  1196.       Result := TUnderlineType(bUnderlineType);
  1197.   end;
  1198. end;
  1199.  
  1200. procedure TRxTextAttributes.SetUnderlineType(Value: TUnderlineType);
  1201. var
  1202.   Format: TCharFormat2;
  1203. begin
  1204.   if RichEditVersion < 2 then Exit;
  1205.   InitFormat(Format);
  1206.   with Format do begin
  1207.     dwMask := CFM_UNDERLINETYPE or CFM_UNDERLINE;
  1208.     bUnderlineType := Ord(Value);
  1209.     if Value <> utNone then dwEffects := dwEffects or CFE_UNDERLINE;
  1210.   end;
  1211.   SetAttributes(Format);
  1212. end;
  1213.  
  1214. function TRxTextAttributes.GetOffset: Integer;
  1215. var
  1216.   Format: TCharFormat2;
  1217. begin
  1218.   GetAttributes(Format);
  1219.   Result := Format.yOffset div 20;
  1220. end;
  1221.  
  1222. procedure TRxTextAttributes.SetOffset(Value: Integer);
  1223. var
  1224.   Format: TCharFormat2;
  1225. begin
  1226.   InitFormat(Format);
  1227.   with Format do begin
  1228.     dwMask := DWORD(CFM_OFFSET);
  1229.     yOffset := Value * 20;
  1230.   end;
  1231.   SetAttributes(Format);
  1232. end;
  1233.  
  1234. function TRxTextAttributes.GetSize: Integer;
  1235. var
  1236.   Format: TCharFormat2;
  1237. begin
  1238.   GetAttributes(Format);
  1239.   Result := Format.yHeight div 20;
  1240. end;
  1241.  
  1242. procedure TRxTextAttributes.SetSize(Value: Integer);
  1243. var
  1244.   Format: TCharFormat2;
  1245. begin
  1246.   InitFormat(Format);
  1247.   with Format do begin
  1248.     dwMask := DWORD(CFM_SIZE);
  1249.     yHeight := Value * 20;
  1250.   end;
  1251.   SetAttributes(Format);
  1252. end;
  1253.  
  1254. function TRxTextAttributes.GetHeight: Integer;
  1255. begin
  1256.   Result := MulDiv(Size, RichEdit.FScreenLogPixels, 72);
  1257. end;
  1258.  
  1259. procedure TRxTextAttributes.SetHeight(Value: Integer);
  1260. begin
  1261.   Size := MulDiv(Value, 72, RichEdit.FScreenLogPixels);
  1262. end;
  1263.  
  1264. function TRxTextAttributes.GetPitch: TFontPitch;
  1265. var
  1266.   Format: TCharFormat2;
  1267. begin
  1268.   GetAttributes(Format);
  1269.   case (Format.bPitchAndFamily and $03) of
  1270.     DEFAULT_PITCH: Result := fpDefault;
  1271.     VARIABLE_PITCH: Result := fpVariable;
  1272.     FIXED_PITCH: Result := fpFixed;
  1273.     else Result := fpDefault;
  1274.   end;
  1275. end;
  1276.  
  1277. procedure TRxTextAttributes.SetPitch(Value: TFontPitch);
  1278. var
  1279.   Format: TCharFormat2;
  1280. begin
  1281.   InitFormat(Format);
  1282.   with Format do begin
  1283.     case Value of
  1284.       fpVariable: bPitchAndFamily := VARIABLE_PITCH;
  1285.       fpFixed: bPitchAndFamily := FIXED_PITCH;
  1286.       else bPitchAndFamily := DEFAULT_PITCH;
  1287.     end;
  1288.   end;
  1289.   SetAttributes(Format);
  1290. end;
  1291.  
  1292. function TRxTextAttributes.GetSubscriptStyle: TSubscriptStyle;
  1293. var
  1294.   Format: TCharFormat2;
  1295. begin
  1296.   Result := ssNone;
  1297.   if RichEditVersion < 2 then Exit;
  1298.   GetAttributes(Format);
  1299.   with Format do begin
  1300.     if (dwEffects and CFE_SUBSCRIPT) <> 0 then
  1301.       Result := ssSubscript
  1302.     else if (dwEffects and CFE_SUPERSCRIPT) <> 0 then
  1303.       Result := ssSuperscript;
  1304.   end;
  1305. end;
  1306.  
  1307. procedure TRxTextAttributes.SetSubscriptStyle(Value: TSubscriptStyle);
  1308. var
  1309.   Format: TCharFormat2;
  1310. begin
  1311.   if RichEditVersion < 2 then Exit;
  1312.   InitFormat(Format);
  1313.   with Format do begin
  1314.     dwMask := DWORD(CFM_SUBSCRIPT);
  1315.     case Value of
  1316.       ssSubscript: dwEffects := CFE_SUBSCRIPT;
  1317.       ssSuperscript: dwEffects := CFE_SUPERSCRIPT;
  1318.     end;
  1319.   end;
  1320.   SetAttributes(Format);
  1321. end;
  1322.  
  1323. procedure TRxTextAttributes.AssignFont(Font: TFont);
  1324. var
  1325.   LogFont: TLogFont;
  1326.   Format: TCharFormat2;
  1327. begin
  1328.   InitFormat(Format);
  1329.   with Format do begin
  1330.     case Font.Pitch of
  1331.       fpVariable: bPitchAndFamily := VARIABLE_PITCH;
  1332.       fpFixed: bPitchAndFamily := FIXED_PITCH;
  1333.       else bPitchAndFamily := DEFAULT_PITCH;
  1334.     end;
  1335.     dwMask := dwMask or CFM_SIZE or CFM_BOLD or CFM_ITALIC or
  1336.       CFM_UNDERLINE or CFM_STRIKEOUT or CFM_FACE or CFM_COLOR;
  1337.     yHeight := Font.Size * 20;
  1338.     if fsBold in Font.Style then dwEffects := dwEffects or CFE_BOLD;
  1339.     if fsItalic in Font.Style then dwEffects := dwEffects or CFE_ITALIC;
  1340.     if fsUnderline in Font.Style then dwEffects := dwEffects or CFE_UNDERLINE;
  1341.     if fsStrikeOut in Font.Style then dwEffects := dwEffects or CFE_STRIKEOUT;
  1342.     StrPLCopy(szFaceName, Font.Name, SizeOf(szFaceName));
  1343.     if (Font.Color = clWindowText) or (Font.Color = clDefault) then
  1344.       dwEffects := CFE_AUTOCOLOR
  1345.     else crTextColor := ColorToRGB(Font.Color);
  1346. {$IFNDEF VER90}
  1347.     dwMask := dwMask or CFM_CHARSET;
  1348.     bCharSet := Font.Charset;
  1349. {$ENDIF}
  1350.     if GetObject(Font.Handle, SizeOf(LogFont), @LogFont) <> 0 then begin
  1351.       dwMask := dwMask or DWORD(CFM_WEIGHT);
  1352.       wWeight := Word(LogFont.lfWeight);
  1353.     end;
  1354.   end;
  1355.   SetAttributes(Format);
  1356. end;
  1357.  
  1358. procedure TRxTextAttributes.Assign(Source: TPersistent);
  1359. var
  1360.   Format: TCharFormat2;
  1361. begin
  1362.   if Source is TFont then AssignFont(TFont(Source))
  1363.   else if Source is TTextAttributes then begin
  1364.     Name := TTextAttributes(Source).Name;
  1365. {$IFDEF RX_D3}
  1366.     Charset := TTextAttributes(Source).Charset;
  1367. {$ENDIF}
  1368.     Style := TTextAttributes(Source).Style;
  1369.     Pitch := TTextAttributes(Source).Pitch;
  1370.     Color := TTextAttributes(Source).Color;
  1371.   end
  1372.   else if Source is TRxTextAttributes then begin
  1373.     TRxTextAttributes(Source).GetAttributes(Format);
  1374.     SetAttributes(Format);
  1375.   end
  1376.   else inherited Assign(Source);
  1377. end;
  1378.  
  1379. procedure TRxTextAttributes.AssignTo(Dest: TPersistent);
  1380. begin
  1381.   if Dest is TFont then begin
  1382.     TFont(Dest).Color := Color;
  1383.     TFont(Dest).Name := Name;
  1384. {$IFNDEF VER90}
  1385.     TFont(Dest).Charset := Charset;
  1386. {$ENDIF}
  1387.     TFont(Dest).Style := Style;
  1388.     TFont(Dest).Size := Size;
  1389.     TFont(Dest).Pitch := Pitch;
  1390.   end
  1391.   else if Dest is TTextAttributes then begin
  1392.     TTextAttributes(Dest).Color := Color;
  1393.     TTextAttributes(Dest).Name := Name;
  1394. {$IFDEF RX_D3}
  1395.     TTextAttributes(Dest).Charset := Charset;
  1396. {$ENDIF}
  1397.     TTextAttributes(Dest).Style := Style;
  1398.     TTextAttributes(Dest).Pitch := Pitch;
  1399.   end
  1400.   else inherited AssignTo(Dest);
  1401. end;
  1402.  
  1403. { TRxParaAttributes }
  1404.  
  1405. constructor TRxParaAttributes.Create(AOwner: TRxCustomRichEdit);
  1406. begin
  1407.   inherited Create;
  1408.   RichEdit := AOwner;
  1409. end;
  1410.  
  1411. procedure TRxParaAttributes.InitPara(var Paragraph: TParaFormat2);
  1412. begin
  1413.   FillChar(Paragraph, SizeOf(Paragraph), 0);
  1414.   if RichEditVersion >= 2 then
  1415.     Paragraph.cbSize := SizeOf(Paragraph)
  1416.   else
  1417.     Paragraph.cbSize := SizeOf(TParaFormat);
  1418. end;
  1419.  
  1420. procedure TRxParaAttributes.GetAttributes(var Paragraph: TParaFormat2);
  1421. begin
  1422.   InitPara(Paragraph);
  1423.   if RichEdit.HandleAllocated then
  1424.     SendMessage(RichEdit.Handle, EM_GETPARAFORMAT, 0, LPARAM(@Paragraph));
  1425. end;
  1426.  
  1427. procedure TRxParaAttributes.SetAttributes(var Paragraph: TParaFormat2);
  1428. begin
  1429. {$IFDEF RX_D4}
  1430.   RichEdit.HandleNeeded; { we REALLY need the handle for BiDi }
  1431. {$ENDIF}
  1432.   if RichEdit.HandleAllocated then begin
  1433. {$IFDEF RX_D4}
  1434.     if RichEdit.UseRightToLeftAlignment then
  1435.       if Paragraph.wAlignment = PFA_LEFT then
  1436.         Paragraph.wAlignment := PFA_RIGHT
  1437.       else if Paragraph.wAlignment = PFA_RIGHT then
  1438.         Paragraph.wAlignment := PFA_LEFT;
  1439. {$ENDIF}
  1440.     SendMessage(RichEdit.Handle, EM_SETPARAFORMAT, 0, LPARAM(@Paragraph));
  1441.   end;
  1442. end;
  1443.  
  1444. function TRxParaAttributes.GetAlignment: TParaAlignment;
  1445. var
  1446.   Paragraph: TParaFormat2;
  1447. begin
  1448.   GetAttributes(Paragraph);
  1449.   Result := TParaAlignment(Paragraph.wAlignment - 1);
  1450. end;
  1451.  
  1452. procedure TRxParaAttributes.SetAlignment(Value: TParaAlignment);
  1453. var
  1454.   Paragraph: TParaFormat2;
  1455. begin
  1456.   InitPara(Paragraph);
  1457.   with Paragraph do
  1458.   begin
  1459.     dwMask := PFM_ALIGNMENT;
  1460.     wAlignment := Ord(Value) + 1;
  1461.   end;
  1462.   SetAttributes(Paragraph);
  1463. end;
  1464.  
  1465. function TRxParaAttributes.GetNumbering: TRxNumbering;
  1466. var
  1467.   Paragraph: TParaFormat2;
  1468. begin
  1469.   GetAttributes(Paragraph);
  1470.   Result := TRxNumbering(Paragraph.wNumbering);
  1471.   if RichEditVersion = 1 then
  1472.     if Result <> nsNone then Result := nsBullet;
  1473. end;
  1474.  
  1475. procedure TRxParaAttributes.SetNumbering(Value: TRxNumbering);
  1476. var
  1477.   Paragraph: TParaFormat2;
  1478. begin
  1479.   if RichEditVersion = 1 then
  1480.     if Value <> nsNone then Value := TRxNumbering(PFN_BULLET);
  1481.   case Value of
  1482.     nsNone: LeftIndent := 0;
  1483.     else if LeftIndent < 10 then LeftIndent := 10;
  1484.   end;
  1485.   InitPara(Paragraph);
  1486.   with Paragraph do begin
  1487.     dwMask := PFM_NUMBERING;
  1488.     wNumbering := Ord(Value);
  1489.   end;
  1490.   SetAttributes(Paragraph);
  1491. end;
  1492.  
  1493. function TRxParaAttributes.GetNumberingStyle: TRxNumberingStyle;
  1494. var
  1495.   Paragraph: TParaFormat2;
  1496. begin
  1497.   if RichEditVersion < 2 then
  1498.     Result := nsSimple
  1499.   else begin
  1500.     GetAttributes(Paragraph);
  1501.     Result := TRxNumberingStyle(Paragraph.wNumberingStyle);
  1502.   end;
  1503. end;
  1504.  
  1505. procedure TRxParaAttributes.SetNumberingStyle(Value: TRxNumberingStyle);
  1506. var
  1507.   Paragraph: TParaFormat2;
  1508. begin
  1509.   if RichEditVersion < 2 then Exit;
  1510.   InitPara(Paragraph);
  1511.   with Paragraph do begin
  1512.     dwMask := PFM_NUMBERINGSTYLE;
  1513.     wNumberingStyle := Ord(Value);
  1514.   end;
  1515.   SetAttributes(Paragraph);
  1516. end;
  1517.  
  1518. function TRxParaAttributes.GetNumberingTab: Word;
  1519. var
  1520.   Paragraph: TParaFormat2;
  1521. begin
  1522.   GetAttributes(Paragraph);
  1523.   Result := Paragraph.wNumberingTab div 20;
  1524. end;
  1525.  
  1526. procedure TRxParaAttributes.SetNumberingTab(Value: Word);
  1527. var
  1528.   Paragraph: TParaFormat2;
  1529. begin
  1530.   if RichEditVersion < 2 then Exit;
  1531.   InitPara(Paragraph);
  1532.   with Paragraph do begin
  1533.     dwMask := PFM_NUMBERINGTAB;
  1534.     wNumberingTab := Value * 20;
  1535.   end;
  1536.   SetAttributes(Paragraph);
  1537. end;
  1538.  
  1539. function TRxParaAttributes.GetFirstIndent: Longint;
  1540. var
  1541.   Paragraph: TParaFormat2;
  1542. begin
  1543.   GetAttributes(Paragraph);
  1544.   Result := Paragraph.dxStartIndent div 20;
  1545. end;
  1546.  
  1547. procedure TRxParaAttributes.SetFirstIndent(Value: Longint);
  1548. var
  1549.   Paragraph: TParaFormat2;
  1550. begin
  1551.   InitPara(Paragraph);
  1552.   with Paragraph do
  1553.   begin
  1554.     dwMask := PFM_STARTINDENT;
  1555.     dxStartIndent := Value * 20;
  1556.   end;
  1557.   SetAttributes(Paragraph);
  1558. end;
  1559.  
  1560. function TRxParaAttributes.GetHeadingStyle: THeadingStyle;
  1561. var
  1562.   Paragraph: TParaFormat2;
  1563. begin
  1564.   if RichEditVersion < 3 then Result := 0
  1565.   else begin
  1566.     GetAttributes(Paragraph);
  1567.     Result := Paragraph.sStyle;
  1568.   end;
  1569. end;
  1570.  
  1571. procedure TRxParaAttributes.SetHeadingStyle(Value: THeadingStyle);
  1572. var
  1573.   Paragraph: TParaFormat2;
  1574. begin
  1575.   if RichEditVersion < 3 then Exit;
  1576.   InitPara(Paragraph);
  1577.   with Paragraph do begin
  1578.     dwMask := PFM_STYLE;
  1579.     sStyle := Value;
  1580.   end;
  1581.   SetAttributes(Paragraph);
  1582. end;
  1583.  
  1584. function TRxParaAttributes.GetLeftIndent: Longint;
  1585. var
  1586.   Paragraph: TParaFormat2;
  1587. begin
  1588.   GetAttributes(Paragraph);
  1589.   Result := Paragraph.dxOffset div 20;
  1590. end;
  1591.  
  1592. procedure TRxParaAttributes.SetLeftIndent(Value: Longint);
  1593. var
  1594.   Paragraph: TParaFormat2;
  1595. begin
  1596.   InitPara(Paragraph);
  1597.   with Paragraph do
  1598.   begin
  1599.     dwMask := PFM_OFFSET;
  1600.     dxOffset := Value * 20;
  1601.   end;
  1602.   SetAttributes(Paragraph);
  1603. end;
  1604.  
  1605. function TRxParaAttributes.GetRightIndent: Longint;
  1606. var
  1607.   Paragraph: TParaFormat2;
  1608. begin
  1609.   GetAttributes(Paragraph);
  1610.   Result := Paragraph.dxRightIndent div 20;
  1611. end;
  1612.  
  1613. procedure TRxParaAttributes.SetRightIndent(Value: Longint);
  1614. var
  1615.   Paragraph: TParaFormat2;
  1616. begin
  1617.   InitPara(Paragraph);
  1618.   with Paragraph do
  1619.   begin
  1620.     dwMask := PFM_RIGHTINDENT;
  1621.     dxRightIndent := Value * 20;
  1622.   end;
  1623.   SetAttributes(Paragraph);
  1624. end;
  1625.  
  1626. function TRxParaAttributes.GetSpaceAfter: Longint;
  1627. var
  1628.   Paragraph: TParaFormat2;
  1629. begin
  1630.   GetAttributes(Paragraph);
  1631.   Result := Paragraph.dySpaceAfter div 20;
  1632. end;
  1633.  
  1634. procedure TRxParaAttributes.SetSpaceAfter(Value: Longint);
  1635. var
  1636.   Paragraph: TParaFormat2;
  1637. begin
  1638.   if RichEditVersion < 2 then Exit;
  1639.   InitPara(Paragraph);
  1640.   with Paragraph do begin
  1641.     dwMask := PFM_SPACEAFTER;
  1642.     dySpaceAfter := Value * 20;
  1643.   end;
  1644.   SetAttributes(Paragraph);
  1645. end;
  1646.  
  1647. function TRxParaAttributes.GetSpaceBefore: Longint;
  1648. var
  1649.   Paragraph: TParaFormat2;
  1650. begin
  1651.   GetAttributes(Paragraph);
  1652.   Result := Paragraph.dySpaceBefore div 20;
  1653. end;
  1654.  
  1655. procedure TRxParaAttributes.SetSpaceBefore(Value: Longint);
  1656. var
  1657.   Paragraph: TParaFormat2;
  1658. begin
  1659.   if RichEditVersion < 2 then Exit;
  1660.   InitPara(Paragraph);
  1661.   with Paragraph do begin
  1662.     dwMask := PFM_SPACEBEFORE;
  1663.     dySpaceBefore := Value * 20;
  1664.   end;
  1665.   SetAttributes(Paragraph);
  1666. end;
  1667.  
  1668. function TRxParaAttributes.GetLineSpacing: Longint;
  1669. var
  1670.   Paragraph: TParaFormat2;
  1671. begin
  1672.   GetAttributes(Paragraph);
  1673.   Result := Paragraph.dyLineSpacing div 20;
  1674. end;
  1675.  
  1676. procedure TRxParaAttributes.SetLineSpacing(Value: Longint);
  1677. var
  1678.   Paragraph: TParaFormat2;
  1679. begin
  1680.   if RichEditVersion < 2 then Exit;
  1681.   GetAttributes(Paragraph);
  1682.   with Paragraph do begin
  1683.     dwMask := PFM_LINESPACING;
  1684.     dyLineSpacing := Value * 20;
  1685.   end;
  1686.   SetAttributes(Paragraph);
  1687. end;
  1688.  
  1689. function TRxParaAttributes.GetLineSpacingRule: TLineSpacingRule;
  1690. var
  1691.   Paragraph: TParaFormat2;
  1692. begin
  1693.   GetAttributes(Paragraph);
  1694.   Result := TLineSpacingRule(Paragraph.bLineSpacingRule);
  1695. end;
  1696.  
  1697. procedure TRxParaAttributes.SetLineSpacingRule(Value: TLineSpacingRule);
  1698. var
  1699.   Paragraph: TParaFormat2;
  1700. begin
  1701.   if RichEditVersion < 2 then Exit;
  1702.   GetAttributes(Paragraph);
  1703.   with Paragraph do begin
  1704.     dwMask := PFM_LINESPACING;
  1705.     bLineSpacingRule := Ord(Value);
  1706.   end;
  1707.   SetAttributes(Paragraph);
  1708. end;
  1709.  
  1710. function TRxParaAttributes.GetTab(Index: Byte): Longint;
  1711. var
  1712.   Paragraph: TParaFormat2;
  1713. begin
  1714.   GetAttributes(Paragraph);
  1715.   Result := Paragraph.rgxTabs[Index] div 20;
  1716. end;
  1717.  
  1718. procedure TRxParaAttributes.SetTab(Index: Byte; Value: Longint);
  1719. var
  1720.   Paragraph: TParaFormat2;
  1721. begin
  1722.   GetAttributes(Paragraph);
  1723.   with Paragraph do
  1724.   begin
  1725.     rgxTabs[Index] := Value * 20;
  1726.     dwMask := PFM_TABSTOPS;
  1727.     if cTabCount < Index then cTabCount := Index;
  1728.     SetAttributes(Paragraph);
  1729.   end;
  1730. end;
  1731.  
  1732. function TRxParaAttributes.GetTabCount: Integer;
  1733. var
  1734.   Paragraph: TParaFormat2;
  1735. begin
  1736.   GetAttributes(Paragraph);
  1737.   Result := Paragraph.cTabCount;
  1738. end;
  1739.  
  1740. procedure TRxParaAttributes.SetTabCount(Value: Integer);
  1741. var
  1742.   Paragraph: TParaFormat2;
  1743. begin
  1744.   GetAttributes(Paragraph);
  1745.   with Paragraph do
  1746.   begin
  1747.     dwMask := PFM_TABSTOPS;
  1748.     cTabCount := Value;
  1749.     SetAttributes(Paragraph);
  1750.   end;
  1751. end;
  1752.  
  1753. function TRxParaAttributes.GetTableStyle: TParaTableStyle;
  1754. var
  1755.   Paragraph: TParaFormat2;
  1756. begin
  1757.   Result := tsNone;
  1758.   if RichEditVersion < 2 then Exit;
  1759.   GetAttributes(Paragraph);
  1760.   with Paragraph do begin
  1761.     if (wReserved and PFE_TABLEROW) <> 0 then
  1762.       Result := tsTableRow
  1763.     else if (wReserved and PFE_TABLECELLEND) <> 0 then
  1764.       Result := tsTableCellEnd
  1765.     else if (wReserved and PFE_TABLECELL) <> 0 then
  1766.       Result := tsTableCell;
  1767.   end;
  1768. end;
  1769.  
  1770. procedure TRxParaAttributes.SetTableStyle(Value: TParaTableStyle);
  1771. var
  1772.   Paragraph: TParaFormat2;
  1773. begin
  1774.   if RichEditVersion < 2 then Exit;
  1775.   InitPara(Paragraph);
  1776.   with Paragraph do begin
  1777.     dwMask := PFM_TABLE;
  1778.     case Value of
  1779.       tsTableRow: wReserved := PFE_TABLEROW;
  1780.       tsTableCellEnd: wReserved := PFE_TABLECELLEND;
  1781.       tsTableCell: wReserved := PFE_TABLECELL;
  1782.     end;
  1783.   end;
  1784.   SetAttributes(Paragraph);
  1785. end;
  1786.  
  1787. procedure TRxParaAttributes.AssignTo(Dest: TPersistent);
  1788. var
  1789.   I: Integer;
  1790. begin
  1791.   if Dest is TParaAttributes then begin
  1792.     with TParaAttributes(Dest) do begin
  1793.       if Self.Alignment = paJustify then Alignment := taLeftJustify
  1794.       else Alignment := TAlignment(Self.Alignment);
  1795.       FirstIndent := Self.FirstIndent;
  1796.       LeftIndent := Self.LeftIndent;
  1797.       RightIndent := Self.RightIndent;
  1798.       if Self.Numbering <> nsNone then
  1799.         Numbering := TNumberingStyle(nsBullet)
  1800.       else Numbering := TNumberingStyle(nsNone);
  1801.       for I := 0 to MAX_TAB_STOPS - 1 do
  1802.         Tab[I] := Self.Tab[I];
  1803.     end;
  1804.   end
  1805.   else inherited AssignTo(Dest);
  1806. end;
  1807.  
  1808. procedure TRxParaAttributes.Assign(Source: TPersistent);
  1809. var
  1810.   I: Integer;
  1811.   Paragraph: TParaFormat2;
  1812. begin
  1813.   if Source is TParaAttributes then begin
  1814.     Alignment := TParaAlignment(TParaAttributes(Source).Alignment);
  1815.     FirstIndent := TParaAttributes(Source).FirstIndent;
  1816.     LeftIndent := TParaAttributes(Source).LeftIndent;
  1817.     RightIndent := TParaAttributes(Source).RightIndent;
  1818.     Numbering := TRxNumbering(TParaAttributes(Source).Numbering);
  1819.     for I := 0 to MAX_TAB_STOPS - 1 do
  1820.       Tab[I] := TParaAttributes(Source).Tab[I];
  1821.   end
  1822.   else if Source is TRxParaAttributes then begin
  1823.     TRxParaAttributes(Source).GetAttributes(Paragraph);
  1824.     SetAttributes(Paragraph);
  1825.   end
  1826.   else inherited Assign(Source);
  1827. end;
  1828.  
  1829. { OLE utility routines }
  1830.  
  1831. function WStrLen(Str: PWideChar): Integer;
  1832. begin
  1833.   Result := 0;
  1834.   while Str[Result] <> #0 do Inc(Result);
  1835. end;
  1836.  
  1837. procedure ReleaseObject(var Obj);
  1838. begin
  1839.   if IUnknown(Obj) <> nil then begin
  1840. {$IFNDEF RX_D3}
  1841.     IUnknown(Obj).Release;
  1842. {$ENDIF}
  1843.     IUnknown(Obj) := nil;
  1844.   end;
  1845. end;
  1846.  
  1847. procedure CreateStorage(var Storage: IStorage);
  1848. var
  1849.   LockBytes: ILockBytes;
  1850. begin
  1851.   OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
  1852.   try
  1853.     OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_READWRITE
  1854.       or STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Storage));
  1855.   finally
  1856.     ReleaseObject(LockBytes);
  1857.   end;
  1858. end;
  1859.  
  1860. procedure DestroyMetaPict(MetaPict: HGlobal);
  1861. begin
  1862.   if MetaPict <> 0 then begin
  1863.     DeleteMetaFile(PMetaFilePict(GlobalLock(MetaPict))^.hMF);
  1864.     GlobalUnlock(MetaPict);
  1865.     GlobalFree(MetaPict);
  1866.   end;
  1867. end;
  1868.  
  1869. function OleSetDrawAspect(OleObject: IOleObject; Iconic: Boolean;
  1870.   IconMetaPict: HGlobal; var DrawAspect: Longint): HResult;
  1871. var
  1872.   OleCache: IOleCache;
  1873.   EnumStatData: IEnumStatData;
  1874.   OldAspect, AdviseFlags, Connection: Longint;
  1875.   TempMetaPict: HGlobal;
  1876.   FormatEtc: TFormatEtc;
  1877.   Medium: TStgMedium;
  1878.   ClassID: TCLSID;
  1879.   StatData: TStatData;
  1880. begin
  1881.   Result := S_OK;
  1882.   OldAspect := DrawAspect;
  1883.   if Iconic then begin
  1884.     DrawAspect := DVASPECT_ICON;
  1885.     AdviseFlags := ADVF_NODATA;
  1886.   end
  1887.   else begin
  1888.     DrawAspect := DVASPECT_CONTENT;
  1889.     AdviseFlags := ADVF_PRIMEFIRST;
  1890.   end;
  1891.   if (DrawAspect <> OldAspect) or (DrawAspect = DVASPECT_ICON) then begin
  1892. {$IFDEF RX_D3}
  1893.     Result := OleObject.QueryInterface(IOleCache, OleCache);
  1894. {$ELSE}
  1895.     Result := OleObject.QueryInterface(IID_IOleCache, OleCache);
  1896. {$ENDIF}
  1897.     if Succeeded(Result) then
  1898.     try
  1899.       if DrawAspect <> OldAspect then begin
  1900.         { Setup new cache with the new aspect }
  1901.         FillChar(FormatEtc, SizeOf(FormatEtc), 0);
  1902.         FormatEtc.dwAspect := DrawAspect;
  1903.         FormatEtc.lIndex := -1;
  1904.         Result := OleCache.Cache(FormatEtc, AdviseFlags, Connection);
  1905.       end;
  1906.       if Succeeded(Result) and (DrawAspect = DVASPECT_ICON) then begin
  1907.         TempMetaPict := 0;
  1908.         if IconMetaPict = 0 then begin
  1909.           if Succeeded(OleObject.GetUserClassID(ClassID)) then begin
  1910.             TempMetaPict := OleGetIconOfClass(ClassID, nil, True);
  1911.             IconMetaPict := TempMetaPict;
  1912.           end;
  1913.         end;
  1914.         try
  1915.           FormatEtc.cfFormat := CF_METAFILEPICT;
  1916.           FormatEtc.ptd := nil;
  1917.           FormatEtc.dwAspect := DVASPECT_ICON;
  1918.           FormatEtc.lIndex := -1;
  1919.           FormatEtc.tymed := TYMED_MFPICT;
  1920.           Medium.tymed := TYMED_MFPICT;
  1921.           Medium.hMetaFilePict := IconMetaPict;
  1922.           Medium.unkForRelease := nil;
  1923.           Result := OleCache.SetData(FormatEtc, Medium, False);
  1924.         finally
  1925.           DestroyMetaPict(TempMetaPict);
  1926.         end;
  1927.       end;
  1928.       if Succeeded(Result) and (DrawAspect <> OldAspect) then begin
  1929.         { remove any existing caches that are set up for the old display aspect }
  1930.         OleCache.EnumCache(EnumStatData);
  1931.         if EnumStatData <> nil then
  1932.         try
  1933.           while EnumStatData.Next(1, StatData, nil) = 0 do
  1934.             if StatData.formatetc.dwAspect = OldAspect then
  1935.               OleCache.Uncache(StatData.dwConnection);
  1936.         finally
  1937.           ReleaseObject(EnumStatData);
  1938.         end;
  1939.       end;
  1940.     finally
  1941.       ReleaseObject(OleCache);
  1942.     end;
  1943.     if Succeeded(Result) and (DrawAspect <> DVASPECT_ICON) then
  1944.       OleObject.Update;
  1945.   end;
  1946. end;
  1947.  
  1948. function GetIconMetaPict(OleObject: IOleObject; DrawAspect: Longint): HGlobal;
  1949. var
  1950.   DataObject: IDataObject;
  1951.   FormatEtc: TFormatEtc;
  1952.   Medium: TStgMedium;
  1953.   ClassID: TCLSID;
  1954. begin
  1955.   Result := 0;
  1956.   if DrawAspect = DVASPECT_ICON then begin
  1957. {$IFDEF RX_D3}
  1958.     OleObject.QueryInterface(IDataObject, DataObject);
  1959. {$ELSE}
  1960.     OleObject.QueryInterface(IID_IDataObject, DataObject);
  1961. {$ENDIF}
  1962.     if DataObject <> nil then begin
  1963.       FormatEtc.cfFormat := CF_METAFILEPICT;
  1964.       FormatEtc.ptd := nil;
  1965.       FormatEtc.dwAspect := DVASPECT_ICON;
  1966.       FormatEtc.lIndex := -1;
  1967.       FormatEtc.tymed := TYMED_MFPICT;
  1968.       if Succeeded(DataObject.GetData(FormatEtc, Medium)) then
  1969.         Result := Medium.hMetaFilePict;
  1970.       ReleaseObject(DataObject);
  1971.     end;
  1972.   end;
  1973.   if Result = 0 then begin
  1974.     OleCheck(OleObject.GetUserClassID(ClassID));
  1975.     Result := OleGetIconOfClass(ClassID, nil, True);
  1976.   end;
  1977. end;
  1978.  
  1979. { Return the first piece of a moniker }
  1980.  
  1981. function OleStdGetFirstMoniker(Moniker: IMoniker): IMoniker;
  1982. var
  1983.   Mksys: Longint;
  1984.   EnumMoniker: IEnumMoniker;
  1985. begin
  1986.   Result := nil;
  1987.   if Moniker <> nil then begin
  1988.     if (Moniker.IsSystemMoniker(Mksys) = 0) and
  1989.       (Mksys = MKSYS_GENERICCOMPOSITE) then
  1990.     begin
  1991.       if Moniker.Enum(True, EnumMoniker) <> 0 then Exit;
  1992.       EnumMoniker.Next(1, Result, nil);
  1993.       ReleaseObject(EnumMoniker);
  1994.     end
  1995.     else begin
  1996. {$IFNDEF RX_D3}
  1997.       Moniker.AddRef;
  1998. {$ENDIF}
  1999.       Result := Moniker;
  2000.     end;
  2001.   end;
  2002. end;
  2003.  
  2004. { Return length of file moniker piece of the given moniker }
  2005.  
  2006. function OleStdGetLenFilePrefixOfMoniker(Moniker: IMoniker): Integer;
  2007. var
  2008.   MkFirst: IMoniker;
  2009.   BindCtx: IBindCtx;
  2010.   Mksys: Longint;
  2011.   P: PWideChar;
  2012. begin
  2013.   Result := 0;
  2014.   if Moniker <> nil then begin
  2015.     MkFirst := OleStdGetFirstMoniker(Moniker);
  2016.     if MkFirst <> nil then begin
  2017.       if (MkFirst.IsSystemMoniker(Mksys) = 0) and
  2018.         (Mksys = MKSYS_FILEMONIKER) then
  2019.       begin
  2020.         if CreateBindCtx(0, BindCtx) = 0 then begin
  2021.           if (MkFirst.GetDisplayName(BindCtx, nil, P) = 0) and (P <> nil) then
  2022.           begin
  2023.             Result := WStrLen(P);
  2024.             CoTaskMemFree(P);
  2025.           end;
  2026.           ReleaseObject(BindCtx);
  2027.         end;
  2028.       end;
  2029.       ReleaseObject(MkFirst);
  2030.     end;
  2031.   end;
  2032. end;
  2033.  
  2034. function CoAllocCStr(const S: string): PChar;
  2035. begin
  2036.   Result := StrCopy(CoTaskMemAlloc(Length(S) + 1), PChar(S));
  2037. end;
  2038.  
  2039. function WStrToString(P: PWideChar): string;
  2040. begin
  2041.   Result := '';
  2042.   if P <> nil then begin
  2043.     Result := WideCharToString(P);
  2044.     CoTaskMemFree(P);
  2045.   end;
  2046. end;
  2047.  
  2048. function GetFullNameStr(OleObject: IOleObject): string;
  2049. var
  2050.   P: PWideChar;
  2051. begin
  2052.   OleObject.GetUserType(USERCLASSTYPE_FULL, P);
  2053.   Result := WStrToString(P);
  2054. end;
  2055.  
  2056. function GetShortNameStr(OleObject: IOleObject): string;
  2057. var
  2058.   P: PWideChar;
  2059. begin
  2060.   OleObject.GetUserType(USERCLASSTYPE_SHORT, P);
  2061.   Result := WStrToString(P);
  2062. end;
  2063.  
  2064. function GetDisplayNameStr(OleLink: IOleLink): string;
  2065. var
  2066.   P: PWideChar;
  2067. begin
  2068.   OleLink.GetSourceDisplayName(P);
  2069.   Result := WStrToString(P);
  2070. end;
  2071.  
  2072. {$IFDEF RX_D3}
  2073. function GetVCLFrameForm(Form: TCustomForm): IVCLFrameForm;
  2074. begin
  2075.   if Form.OleFormObject = nil then TOleForm.Create(Form);
  2076.   Result := Form.OleFormObject as IVCLFrameForm;
  2077. end;
  2078.  
  2079. function IsFormMDIChild(Form: TCustomForm): Boolean;
  2080. begin
  2081.   Result := (Form is TForm) and (TForm(Form).FormStyle = fsMDIChild);
  2082. end;
  2083. {$ENDIF}
  2084.  
  2085. { Clipboard formats }
  2086.  
  2087. var
  2088.   CFEmbeddedObject: Integer;
  2089.   CFLinkSource: Integer;
  2090.   CFRtf: Integer;
  2091.   CFRtfNoObjs: Integer;
  2092.  
  2093. const
  2094. {$IFNDEF RX_D3}
  2095.   CF_RTFNOOBJS = 'Rich Text Format Without Objects';
  2096. {$ENDIF}
  2097.   CF_EMBEDDEDOBJECT = 'Embedded Object';
  2098.   CF_LINKSOURCE = 'Link Source';
  2099.  
  2100. {************************************************************************}
  2101.  
  2102. { OLE Extensions to the Rich Text Editor }
  2103. { Converted from RICHOLE.H               }
  2104.  
  2105. { Structure passed to GetObject and InsertObject }
  2106.  
  2107. type
  2108.   _ReObject = record
  2109.     cbStruct: DWORD;           { Size of structure                }
  2110.     cp: ULONG;                 { Character position of object     }
  2111.     clsid: TCLSID;             { Class ID of object               }
  2112.     poleobj: IOleObject;       { OLE object interface             }
  2113.     pstg: IStorage;            { Associated storage interface     }
  2114.     polesite: IOleClientSite;  { Associated client site interface }
  2115.     sizel: TSize;              { Size of object (may be 0,0)      }
  2116.     dvAspect: Longint;         { Display aspect to use            }
  2117.     dwFlags: DWORD;            { Object status flags              }
  2118.     dwUser: DWORD;             { Dword for user's use             }
  2119.   end;
  2120.   TReObject = _ReObject;
  2121.  
  2122. const
  2123.  
  2124. { Flags to specify which interfaces should be returned in the structure above }
  2125.  
  2126.   REO_GETOBJ_NO_INTERFACES   =  $00000000;
  2127.   REO_GETOBJ_POLEOBJ         =  $00000001;
  2128.   REO_GETOBJ_PSTG            =  $00000002;
  2129.   REO_GETOBJ_POLESITE        =  $00000004;
  2130.   REO_GETOBJ_ALL_INTERFACES  =  $00000007;
  2131.  
  2132. { Place object at selection }
  2133.  
  2134.   REO_CP_SELECTION    = ULONG(-1);
  2135.  
  2136. { Use character position to specify object instead of index }
  2137.  
  2138.   REO_IOB_SELECTION   = ULONG(-1);
  2139.   REO_IOB_USE_CP      = ULONG(-2);
  2140.  
  2141. { Object flags }
  2142.  
  2143.   REO_NULL            = $00000000;  { No flags                         }
  2144.   REO_READWRITEMASK   = $0000003F;  { Mask out RO bits                 }
  2145.   REO_DONTNEEDPALETTE = $00000020;  { Object doesn't need palette      }
  2146.   REO_BLANK           = $00000010;  { Object is blank                  }
  2147.   REO_DYNAMICSIZE     = $00000008;  { Object defines size always       }
  2148.   REO_INVERTEDSELECT  = $00000004;  { Object drawn all inverted if sel }
  2149.   REO_BELOWBASELINE   = $00000002;  { Object sits below the baseline   }
  2150.   REO_RESIZABLE       = $00000001;  { Object may be resized            }
  2151.   REO_LINK            = $80000000;  { Object is a link (RO)            }
  2152.   REO_STATIC          = $40000000;  { Object is static (RO)            }
  2153.   REO_SELECTED        = $08000000;  { Object selected (RO)             }
  2154.   REO_OPEN            = $04000000;  { Object open in its server (RO)   }
  2155.   REO_INPLACEACTIVE   = $02000000;  { Object in place active (RO)      }
  2156.   REO_HILITED         = $01000000;  { Object is to be hilited (RO)     }
  2157.   REO_LINKAVAILABLE   = $00800000;  { Link believed available (RO)     }
  2158.   REO_GETMETAFILE     = $00400000;  { Object requires metafile (RO)    }
  2159.  
  2160. { Flags for IRichEditOle.GetClipboardData,   }
  2161. { IRichEditOleCallback.GetClipboardData and  }
  2162. { IRichEditOleCallback.QueryAcceptData       }
  2163.  
  2164.   RECO_PASTE          = $00000000;  { paste from clipboard  }
  2165.   RECO_DROP           = $00000001;  { drop                  }
  2166.   RECO_COPY           = $00000002;  { copy to the clipboard }
  2167.   RECO_CUT            = $00000003;  { cut to the clipboard  }
  2168.   RECO_DRAG           = $00000004;  { drag                  }
  2169.  
  2170. { RichEdit GUIDs }
  2171.  
  2172.   IID_IRichEditOle: TGUID = (
  2173.     D1:$00020D00;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  2174.   IID_IRichEditOleCallback: TGUID = (
  2175.     D1:$00020D03;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
  2176.  
  2177. type
  2178.  
  2179. {
  2180.  *  IRichEditOle
  2181.  *
  2182.  *  Purpose:
  2183.  *    Interface used by the client of RichEdit to perform OLE-related
  2184.  *    operations.
  2185.  *
  2186.  *    The methods herein may just want to be regular Windows messages.
  2187. }
  2188.  
  2189. {$IFDEF RX_D3}
  2190.   IRichEditOle = interface(IUnknown)
  2191.     ['{00020d00-0000-0000-c000-000000000046}']
  2192.     function GetClientSite(out clientSite: IOleClientSite): HResult; stdcall;
  2193.     function GetObjectCount: HResult; stdcall;
  2194.     function GetLinkCount: HResult; stdcall;
  2195.     function GetObject(iob: Longint; out reobject: TReObject;
  2196.       dwFlags: DWORD): HResult; stdcall;
  2197.     function InsertObject(var reobject: TReObject): HResult; stdcall;
  2198.     function ConvertObject(iob: Longint; rclsidNew: TIID;
  2199.       lpstrUserTypeNew: LPCSTR): HResult; stdcall;
  2200.     function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; stdcall;
  2201.     function SetHostNames(lpstrContainerApp: LPCSTR;
  2202.       lpstrContainerObj: LPCSTR): HResult; stdcall;
  2203.     function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; stdcall;
  2204.     function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; stdcall;
  2205.     function HandsOffStorage(iob: Longint): HResult; stdcall;
  2206.     function SaveCompleted(iob: Longint; const stg: IStorage): HResult; stdcall;
  2207.     function InPlaceDeactivate: HResult; stdcall;
  2208.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  2209.     function GetClipboardData(var chrg: TCharRange; reco: DWORD;
  2210.       out dataobj: IDataObject): HResult; stdcall;
  2211.     function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
  2212.       hMetaPict: HGLOBAL): HResult; stdcall;
  2213.   end;
  2214. {$ELSE}
  2215.   IRichEditOle = class(IUnknown)
  2216.     function GetClientSite(var clientSite: IOleClientSite): HResult; virtual; stdcall; abstract;
  2217.     function GetObjectCount: HResult; virtual; stdcall; abstract;
  2218.     function GetLinkCount: HResult; virtual; stdcall; abstract;
  2219.     function GetObject(iob: Longint; var reobject: TReObject;
  2220.       dwFlags: DWORD): HResult; virtual; stdcall; abstract;
  2221.     function InsertObject(var reobject: TReObject): HResult; virtual; stdcall; abstract;
  2222.     function ConvertObject(iob: Longint; rclsidNew: TIID;
  2223.       lpstrUserTypeNew: LPCSTR): HResult; virtual; stdcall; abstract;
  2224.     function ActivateAs(rclsid: TIID; rclsidAs: TIID): HResult; virtual; stdcall; abstract;
  2225.     function SetHostNames(lpstrContainerApp: LPCSTR;
  2226.       lpstrContainerObj: LPCSTR): HResult; virtual; stdcall; abstract;
  2227.     function SetLinkAvailable(iob: Longint; fAvailable: BOOL): HResult; virtual; stdcall; abstract;
  2228.     function SetDvaspect(iob: Longint; dvaspect: DWORD): HResult; virtual; stdcall; abstract;
  2229.     function HandsOffStorage(iob: Longint): HResult; virtual; stdcall; abstract;
  2230.     function SaveCompleted(iob: Longint; const stg: IStorage): HResult; virtual; stdcall; abstract;
  2231.     function InPlaceDeactivate: HResult; virtual; stdcall; abstract;
  2232.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; virtual; stdcall; abstract;
  2233.     function GetClipboardData(var chrg: TCharRange; reco: DWORD;
  2234.       var dataobj: IDataObject): HResult; virtual; stdcall; abstract;
  2235.     function ImportDataObject(dataobj: IDataObject; cf: TClipFormat;
  2236.       hMetaPict: HGLOBAL): HResult; virtual; stdcall; abstract;
  2237.   end;
  2238. {$ENDIF}
  2239.  
  2240. {
  2241.  *  IRichEditOleCallback
  2242.  *
  2243.  *  Purpose:
  2244.  *    Interface used by the RichEdit to get OLE-related stuff from the
  2245.  *    application using RichEdit.
  2246. }
  2247.  
  2248. {$IFDEF RX_D3}
  2249.   IRichEditOleCallback = interface(IUnknown)
  2250.     ['{00020d03-0000-0000-c000-000000000046}']
  2251.     function GetNewStorage(out stg: IStorage): HResult; stdcall;
  2252.     function GetInPlaceContext(out Frame: IOleInPlaceFrame;
  2253.       out Doc: IOleInPlaceUIWindow;
  2254.       lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall;
  2255.     function ShowContainerUI(fShow: BOOL): HResult; stdcall;
  2256.     function QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2257.       cp: Longint): HResult; stdcall;
  2258.     function DeleteObject(const oleobj: IOleObject): HResult; stdcall;
  2259.     function QueryAcceptData(const dataobj: IDataObject;
  2260.       var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
  2261.       hMetaPict: HGLOBAL): HResult; stdcall;
  2262.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
  2263.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2264.       out dataobj: IDataObject): HResult; stdcall;
  2265.     function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2266.       var dwEffect: DWORD): HResult; stdcall;
  2267.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2268.       const chrg: TCharRange; out menu: HMENU): HResult; stdcall;
  2269.   end;
  2270. {$ELSE}
  2271.   IRichEditOleCallback = class(IUnknown)
  2272.     function GetNewStorage(var stg: IStorage): HResult; virtual; stdcall; abstract;
  2273.     function GetInPlaceContext(var Frame: IOleInPlaceFrame;
  2274.       var Doc: IOleInPlaceUIWindow;
  2275.       lpFrameInfo: POleInPlaceFrameInfo): HResult; virtual; stdcall; abstract;
  2276.     function ShowContainerUI(fShow: BOOL): HResult; virtual; stdcall; abstract;
  2277.     function QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2278.       cp: Longint): HResult; virtual; stdcall; abstract;
  2279.     function DeleteObject(const oleobj: IOleObject): HResult; virtual; stdcall; abstract;
  2280.     function QueryAcceptData(const dataobj: IDataObject;
  2281.       var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
  2282.       hMetaPict: HGLOBAL): HResult; virtual; stdcall; abstract;
  2283.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult; virtual; stdcall; abstract;
  2284.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2285.       var dataobj: IDataObject): HResult; virtual; stdcall; abstract;
  2286.     function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2287.       var dwEffect: DWORD): HResult; virtual; stdcall; abstract;
  2288.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2289.       const chrg: TCharRange; var menu: HMENU): HResult; virtual; stdcall; abstract;
  2290.   end;
  2291. {$ENDIF}
  2292.  
  2293. {************************************************************************}
  2294.  
  2295. { TRichEditOleCallback }
  2296.  
  2297. type
  2298. {$IFDEF RX_D3}
  2299.   TRichEditOleCallback = class(TObject, IUnknown, IRichEditOleCallback)
  2300.   private
  2301.     FDocForm: IVCLFrameForm;
  2302.     FFrameForm: IVCLFrameForm;
  2303.     FAccelTable: HAccel;
  2304.     FAccelCount: Integer;
  2305. {$IFDEF RX_D4}
  2306.     FAutoScroll: Boolean;
  2307. {$ENDIF}
  2308.     procedure CreateAccelTable;
  2309.     procedure DestroyAccelTable;
  2310.     procedure AssignFrame;
  2311. {$ELSE}
  2312.   TRichEditOleCallback = class(IRichEditOleCallback)
  2313. {$ENDIF}
  2314.   private
  2315.     FRefCount: Longint;
  2316.     FRichEdit: TRxCustomRichEdit;
  2317.   public
  2318.     constructor Create(RichEdit: TRxCustomRichEdit);
  2319.     destructor Destroy; override;
  2320. {$IFDEF RX_D3}
  2321.     function QueryInterface(const iid: TGUID; out Obj): HResult; stdcall;
  2322.     function _AddRef: Longint; stdcall;
  2323.     function _Release: Longint; stdcall;
  2324.     function GetNewStorage(out stg: IStorage): HResult; stdcall;
  2325.     function GetInPlaceContext(out Frame: IOleInPlaceFrame;
  2326.       out Doc: IOleInPlaceUIWindow;
  2327.       lpFrameInfo: POleInPlaceFrameInfo): HResult; stdcall;
  2328.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2329.       out dataobj: IDataObject): HResult; stdcall;
  2330.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2331.       const chrg: TCharRange; out menu: HMENU): HResult; stdcall;
  2332. {$ELSE}
  2333.     function QueryInterface(const iid: TIID; var Obj): HResult; override;
  2334.     function AddRef: Longint; override;
  2335.     function Release: Longint; override;
  2336.     function GetNewStorage(var stg: IStorage): HResult; override;
  2337.     function GetInPlaceContext(var Frame: IOleInPlaceFrame;
  2338.       var Doc: IOleInPlaceUIWindow;
  2339.       lpFrameInfo: POleInPlaceFrameInfo): HResult; override;
  2340.     function GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2341.       var dataobj: IDataObject): HResult; override;
  2342.     function GetContextMenu(seltype: Word; const oleobj: IOleObject;
  2343.       const chrg: TCharRange; var menu: HMENU): HResult; override;
  2344. {$ENDIF}
  2345.     function ShowContainerUI(fShow: BOOL): HResult;
  2346.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2347.     function QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2348.       cp: Longint): HResult;
  2349.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2350.     function DeleteObject(const oleobj: IOleObject): HResult;
  2351.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2352.     function QueryAcceptData(const dataobj: IDataObject; var cfFormat: TClipFormat;
  2353.       reco: DWORD; fReally: BOOL; hMetaPict: HGLOBAL): HResult;
  2354.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2355.     function ContextSensitiveHelp(fEnterMode: BOOL): HResult;
  2356.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2357.     function GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2358.       var dwEffect: DWORD): HResult;
  2359.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2360.   end;
  2361.  
  2362. constructor TRichEditOleCallback.Create(RichEdit: TRxCustomRichEdit);
  2363. begin
  2364.   inherited Create;
  2365.   FRichEdit := RichEdit;
  2366. end;
  2367.  
  2368. destructor TRichEditOleCallback.Destroy;
  2369. begin
  2370. {$IFDEF RX_D3}
  2371.   DestroyAccelTable;
  2372.   FFrameForm := nil;
  2373.   FDocForm := nil;
  2374. {$ENDIF}
  2375.   inherited Destroy;
  2376. end;
  2377.  
  2378. {$IFDEF RX_D3}
  2379.  
  2380. function TRichEditOleCallback.QueryInterface(const iid: TGUID; out Obj): HResult;
  2381. begin
  2382.   if GetInterface(iid, Obj) then Result := S_OK
  2383.   else Result := E_NOINTERFACE;
  2384. end;
  2385.  
  2386. function TRichEditOleCallback._AddRef: Longint;
  2387. begin
  2388.   Inc(FRefCount);
  2389.   Result := FRefCount;
  2390. end;
  2391.  
  2392. function TRichEditOleCallback._Release: Longint;
  2393. begin
  2394.   Dec(FRefCount);
  2395.   Result := FRefCount;
  2396. end;
  2397.  
  2398. procedure TRichEditOleCallback.CreateAccelTable;
  2399. var
  2400.   Menu: TMainMenu;
  2401. begin
  2402.   if (FAccelTable = 0) and Assigned(FFrameForm) then begin
  2403.     Menu := FFrameForm.Form.Menu;
  2404.     if Menu <> nil then
  2405.       Menu.GetOle2AcceleratorTable(FAccelTable, FAccelCount, [0, 2, 4]);
  2406.   end;
  2407. end;
  2408.  
  2409. procedure TRichEditOleCallback.DestroyAccelTable;
  2410. begin
  2411.   if FAccelTable <> 0 then begin
  2412.     DestroyAcceleratorTable(FAccelTable);
  2413.     FAccelTable := 0;
  2414.     FAccelCount := 0;
  2415.   end;
  2416. end;
  2417.  
  2418. procedure TRichEditOleCallback.AssignFrame;
  2419. begin
  2420.   if (GetParentForm(FRichEdit) <> nil) and not Assigned(FFrameForm) and
  2421.     FRichEdit.AllowInPlace then
  2422.   begin
  2423.     FDocForm := GetVCLFrameForm(ValidParentForm(FRichEdit));
  2424.     FFrameForm := FDocForm;
  2425.     if IsFormMDIChild(FDocForm.Form) then
  2426.       FFrameForm := GetVCLFrameForm(Application.MainForm);
  2427.   end;
  2428. end;
  2429.  
  2430. {$ELSE}
  2431.  
  2432. function TRichEditOleCallback.QueryInterface(const iid: TIID; var Obj): HResult;
  2433. begin
  2434.   if IsEqualIID(iid, IID_IUnknown) or
  2435.     IsEqualIID(iid, IID_IRichEditOleCallback) then
  2436.   begin
  2437.     Pointer(Obj) := Self;
  2438.     AddRef;
  2439.     Result := S_OK;
  2440.   end else begin
  2441.     Pointer(Obj) := nil;
  2442.     Result := E_NOINTERFACE;
  2443.   end;
  2444. end;
  2445.  
  2446. function TRichEditOleCallback.AddRef: Longint;
  2447. begin
  2448.   Inc(FRefCount);
  2449.   Result := FRefCount;
  2450. end;
  2451.  
  2452. function TRichEditOleCallback.Release: Longint;
  2453. begin
  2454.   Dec(FRefCount);
  2455.   Result := FRefCount;
  2456. end;
  2457.  
  2458. {$ENDIF RX_D3}
  2459.  
  2460. function TRichEditOleCallback.GetNewStorage(
  2461.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} stg: IStorage): HResult;
  2462. begin
  2463.   try
  2464.     CreateStorage(stg);
  2465.     Result := S_OK;
  2466.   except
  2467.     Result:= E_OUTOFMEMORY;
  2468.   end;
  2469. end;
  2470.  
  2471. function TRichEditOleCallback.GetInPlaceContext(
  2472.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} Frame: IOleInPlaceFrame;
  2473.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} Doc: IOleInPlaceUIWindow;
  2474.   lpFrameInfo: POleInPlaceFrameInfo): HResult;
  2475. begin
  2476. {$IFDEF RX_D3}
  2477.   AssignFrame;
  2478.   if Assigned(FFrameForm) and FRichEdit.AllowInPlace then begin
  2479.     Frame := FFrameForm;
  2480.     Doc := FDocForm;
  2481.     CreateAccelTable;
  2482.     with lpFrameInfo^ do begin
  2483.       fMDIApp := False;
  2484.       FFrameForm.GetWindow(hWndFrame);
  2485.       hAccel := FAccelTable;
  2486.       cAccelEntries := FAccelCount;
  2487.     end;
  2488.     Result := S_OK;
  2489.   end
  2490.   else Result := E_NOTIMPL;
  2491. {$ELSE}
  2492.   Result := E_NOTIMPL;
  2493. {$ENDIF}
  2494. end;
  2495.  
  2496. function TRichEditOleCallback.QueryInsertObject(const clsid: TCLSID; const stg: IStorage;
  2497.   cp: Longint): HResult;
  2498. begin
  2499.   Result := NOERROR;
  2500. end;
  2501.  
  2502. function TRichEditOleCallback.DeleteObject(const oleobj: IOleObject): HResult;
  2503. begin
  2504.   if Assigned(oleobj) then oleobj.Close(OLECLOSE_NOSAVE);
  2505.   Result := NOERROR;
  2506. end;
  2507.  
  2508. function TRichEditOleCallback.QueryAcceptData(const dataobj: IDataObject;
  2509.   var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
  2510.   hMetaPict: HGLOBAL): HResult;
  2511. begin
  2512.   Result := S_OK;
  2513. end;
  2514.  
  2515. function TRichEditOleCallback.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
  2516. begin
  2517.   Result := NOERROR;
  2518. end;
  2519.  
  2520. function TRichEditOleCallback.GetClipboardData(const chrg: TCharRange; reco: DWORD;
  2521.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} dataobj: IDataObject): HResult;
  2522. begin
  2523.   Result := E_NOTIMPL;
  2524. end;
  2525.  
  2526. function TRichEditOleCallback.GetDragDropEffect(fDrag: BOOL; grfKeyState: DWORD;
  2527.   var dwEffect: DWORD): HResult;
  2528. begin
  2529.   Result := E_NOTIMPL;
  2530. end;
  2531.  
  2532. function TRichEditOleCallback.GetContextMenu(seltype: Word;
  2533.   const oleobj: IOleObject; const chrg: TCharRange;
  2534.   {$IFDEF RX_D3} out {$ELSE} var {$ENDIF} menu: HMENU): HResult;
  2535. begin
  2536.   Result := E_NOTIMPL;
  2537. end;
  2538.  
  2539. function TRichEditOleCallback.ShowContainerUI(fShow: BOOL): HResult;
  2540. begin
  2541. {$IFDEF RX_D3}
  2542.   if not fShow then AssignFrame;
  2543.   if Assigned(FFrameForm) then begin
  2544.     if fShow then begin
  2545.       FFrameForm.SetMenu(0, 0, 0);
  2546.       FFrameForm.ClearBorderSpace;
  2547.       FRichEdit.SetUIActive(False);
  2548.       DestroyAccelTable;
  2549. {$IFDEF RX_D4}
  2550.       TForm(FFrameForm.Form).AutoScroll := FAutoScroll;
  2551. {$ENDIF}
  2552.       FFrameForm := nil;
  2553.       FDocForm := nil;
  2554.     end
  2555.     else begin
  2556. {$IFDEF RX_D4}
  2557.       FAutoScroll := TForm(FFrameForm.Form).AutoScroll;
  2558.       TForm(FFrameForm.Form).AutoScroll := False;
  2559. {$ENDIF}
  2560.       FRichEdit.SetUIActive(True);
  2561.     end;
  2562.     Result := S_OK;
  2563.   end
  2564.   else Result := E_NOTIMPL;
  2565. {$ELSE}
  2566.   Result := E_NOTIMPL;
  2567. {$ENDIF}
  2568. end;
  2569.  
  2570. { TOleUIObjInfo - helper interface for Object Properties dialog }
  2571.  
  2572. type
  2573. {$IFDEF RX_D3}
  2574.   TOleUIObjInfo = class(TInterfacedObject, IOleUIObjInfo)
  2575. {$ELSE}
  2576.   TOleUIObjInfo = class(IOleUIObjInfo)
  2577. {$ENDIF}
  2578.   private
  2579.     FRichEdit: TRxCustomRichEdit;
  2580.     FReObject: TReObject;
  2581.   public
  2582.     constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject);
  2583. {$IFNDEF RX_D3}
  2584.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  2585.     function AddRef: Longint; override;
  2586.     function Release: Longint; override;
  2587. {$ENDIF}
  2588.     function GetObjectInfo(dwObject: Longint;
  2589.       var dwObjSize: Longint; var lpszLabel: PChar;
  2590.       var lpszType: PChar; var lpszShortType: PChar;
  2591.       var lpszLocation: PChar): HResult;
  2592.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2593.     function GetConvertInfo(dwObject: Longint; var ClassID: TCLSID;
  2594.       var wFormat: Word; var ConvertDefaultClassID: TCLSID;
  2595.       var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult;
  2596.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2597.     function ConvertObject(dwObject: Longint;
  2598.       const clsidNew: TCLSID): HResult;
  2599.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2600.     function GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal;
  2601.       var dvAspect: Longint; var nCurrentScale: Integer): HResult;
  2602.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2603.     function SetViewInfo(dwObject: Longint; hMetaPict: HGlobal;
  2604.       dvAspect: Longint; nCurrentScale: Integer;
  2605.       bRelativeToOrig: BOOL): HResult;
  2606.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2607.   end;
  2608.  
  2609. constructor TOleUIObjInfo.Create(RichEdit: TRxCustomRichEdit;
  2610.   ReObject: TReObject);
  2611. begin
  2612.   inherited Create;
  2613.   FRichEdit := RichEdit;
  2614.   FReObject := ReObject;
  2615. end;
  2616.  
  2617. {$IFNDEF RX_D3}
  2618.  
  2619. function TOleUIObjInfo.QueryInterface(const iid: TIID; var obj): HResult;
  2620. begin
  2621.   Pointer(obj) := nil;
  2622.   Result := E_NOINTERFACE;
  2623. end;
  2624.  
  2625. function TOleUIObjInfo.AddRef: Longint;
  2626. begin
  2627.   Result := 0;
  2628. end;
  2629.  
  2630. function TOleUIObjInfo.Release: Longint;
  2631. begin
  2632.   Result := 0;
  2633. end;
  2634.  
  2635. {$ENDIF RX_D3}
  2636.  
  2637. function TOleUIObjInfo.GetObjectInfo(dwObject: Longint;
  2638.   var dwObjSize: Longint; var lpszLabel: PChar;
  2639.   var lpszType: PChar; var lpszShortType: PChar;
  2640.   var lpszLocation: PChar): HResult;
  2641. begin
  2642.   if @dwObjSize <> nil then
  2643.     dwObjSize := -1 { Unknown size };
  2644.   if @lpszLabel <> nil then
  2645.     lpszLabel := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
  2646.   if @lpszType <> nil then
  2647.     lpszType := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
  2648.   if @lpszShortType <> nil then
  2649.     lpszShortType := CoAllocCStr(GetShortNameStr(FReObject.poleobj));
  2650.   if (@lpszLocation <> nil) then begin
  2651.     if Trim(FRichEdit.Title) <> '' then
  2652.       lpszLocation := CoAllocCStr(Format('%s - %s',
  2653.         [FRichEdit.Title, Application.Title]))
  2654.     else
  2655.       lpszLocation := CoAllocCStr(Application.Title);
  2656.   end;
  2657.   Result := S_OK;
  2658. end;
  2659.  
  2660. function TOleUIObjInfo.GetConvertInfo(dwObject: Longint; var ClassID: TCLSID;
  2661.   var wFormat: Word; var ConvertDefaultClassID: TCLSID;
  2662.   var lpClsidExclude: PCLSID; var cClsidExclude: Longint): HResult;
  2663. begin
  2664.   FReObject.poleobj.GetUserClassID(ClassID);
  2665.   Result := S_OK;
  2666. end;
  2667.  
  2668. function TOleUIObjInfo.ConvertObject(dwObject: Longint;
  2669.   const clsidNew: TCLSID): HResult;
  2670. begin
  2671.   Result := E_NOTIMPL;
  2672. end;
  2673.  
  2674. function TOleUIObjInfo.GetViewInfo(dwObject: Longint; var hMetaPict: HGlobal;
  2675.   var dvAspect: Longint; var nCurrentScale: Integer): HResult;
  2676. begin
  2677.   if @hMetaPict <> nil then
  2678.     hMetaPict := GetIconMetaPict(FReObject.poleobj, FReObject.dvAspect);
  2679.   if @dvAspect <> nil then dvAspect := FReObject.dvAspect;
  2680.   if @nCurrentScale <> nil then nCurrentScale := 0;
  2681.   Result := S_OK;
  2682. end;
  2683.  
  2684. function TOleUIObjInfo.SetViewInfo(dwObject: Longint; hMetaPict: HGlobal;
  2685.   dvAspect: Longint; nCurrentScale: Integer;
  2686.   bRelativeToOrig: BOOL): HResult;
  2687. var
  2688.   Iconic: Boolean;
  2689. begin
  2690.   if Assigned(FRichEdit.FRichEditOle) then begin
  2691.     case dvAspect of
  2692.       DVASPECT_CONTENT:
  2693.         Iconic := False;
  2694.       DVASPECT_ICON:
  2695.         Iconic := True;
  2696.       else
  2697.         Iconic := FReObject.dvAspect = DVASPECT_ICON;
  2698.     end;
  2699.     IRichEditOle(FRichEdit.FRichEditOle).InPlaceDeactivate;
  2700.     Result := OleSetDrawAspect(FReObject.poleobj, Iconic, hMetaPict,
  2701.       FReObject.dvAspect);
  2702.     if Succeeded(Result) then
  2703.       IRichEditOle(FRichEdit.FRichEditOle).SetDvaspect(
  2704.         Longint(REO_IOB_SELECTION), FReObject.dvAspect);
  2705.   end
  2706.   else Result := E_NOTIMPL;
  2707. end;
  2708.  
  2709. { TOleUILinkInfo - helper interface for Object Properties dialog }
  2710.  
  2711. type
  2712. {$IFDEF RX_D3}
  2713.   TOleUILinkInfo = class(TInterfacedObject, IOleUILinkInfo)
  2714. {$ELSE}
  2715.   TOleUILinkInfo = class(IOleUILinkInfo)
  2716. {$ENDIF}
  2717.   private
  2718.     FReObject: TReObject;
  2719.     FRichEdit: TRxCustomRichEdit;
  2720.     FOleLink: IOleLink;
  2721.   public
  2722.     constructor Create(RichEdit: TRxCustomRichEdit; ReObject: TReObject);
  2723. {$IFNDEF RX_D3}
  2724.     destructor Destroy; override;
  2725.     function QueryInterface(const iid: TIID; var obj): HResult; override;
  2726.     function AddRef: Longint; override;
  2727.     function Release: Longint; override;
  2728. {$ENDIF}
  2729.     function GetNextLink(dwLink: Longint): Longint;
  2730.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2731.     function SetLinkUpdateOptions(dwLink: Longint;
  2732.       dwUpdateOpt: Longint): HResult;
  2733.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2734.     function GetLinkUpdateOptions(dwLink: Longint;
  2735.       var dwUpdateOpt: Longint): HResult;
  2736.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2737.     function SetLinkSource(dwLink: Longint; pszDisplayName: PChar;
  2738.       lenFileName: Longint; var chEaten: Longint;
  2739.       fValidateSource: BOOL): HResult;
  2740.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2741.     function GetLinkSource(dwLink: Longint; var pszDisplayName: PChar;
  2742.       var lenFileName: Longint; var pszFullLinkType: PChar;
  2743.       var pszShortLinkType: PChar; var fSourceAvailable: BOOL;
  2744.       var fIsSelected: BOOL): HResult;
  2745.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2746.     function OpenLinkSource(dwLink: Longint): HResult;
  2747.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2748.     function UpdateLink(dwLink: Longint; fErrorMessage: BOOL;
  2749.       fErrorAction: BOOL): HResult;
  2750.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2751.     function CancelLink(dwLink: Longint): HResult;
  2752.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2753.     function GetLastUpdate(dwLink: Longint;
  2754.       var LastUpdate: TFileTime): HResult;
  2755.       {$IFDEF RX_D3} stdcall {$ELSE} override {$ENDIF};
  2756.   end;
  2757.  
  2758. {$IFDEF RX_D3}
  2759. procedure LinkError(const Ident: string);
  2760. begin
  2761.   Application.MessageBox(PChar(Ident), PChar(SLinkProperties),
  2762.     MB_OK or MB_ICONSTOP);
  2763. end;
  2764. {$ELSE}
  2765. procedure LinkError(Ident: Integer);
  2766. begin
  2767.   Application.MessageBox(PChar(LoadStr(Ident)),
  2768.     PChar(LoadStr(SLinkProperties)), MB_OK or MB_ICONSTOP);
  2769. end;
  2770. {$ENDIF}
  2771.  
  2772. constructor TOleUILinkInfo.Create(RichEdit: TRxCustomRichEdit;
  2773.   ReObject: TReObject);
  2774. begin
  2775.   inherited Create;
  2776.   FReObject := ReObject;
  2777.   FRichEdit := RichEdit;
  2778. {$IFDEF RX_D3}
  2779.   OleCheck(FReObject.poleobj.QueryInterface(IOleLink, FOleLink));
  2780. {$ELSE}
  2781.   OleCheck(FReObject.poleobj.QueryInterface(IID_IOleLink, FOleLink));
  2782. {$ENDIF}
  2783. end;
  2784.  
  2785. {$IFNDEF RX_D3}
  2786.  
  2787. destructor TOleUILinkInfo.Destroy;
  2788. begin
  2789.   ReleaseObject(FOleLink);
  2790.   inherited Destroy;
  2791. end;
  2792.  
  2793. function TOleUILinkInfo.QueryInterface(const iid: TIID; var obj): HResult;
  2794. begin
  2795.   Pointer(obj) := nil;
  2796.   Result := E_NOINTERFACE;
  2797. end;
  2798.  
  2799. function TOleUILinkInfo.AddRef: Longint;
  2800. begin
  2801.   Result := 0;
  2802. end;
  2803.  
  2804. function TOleUILinkInfo.Release: Longint;
  2805. begin
  2806.   Result := 0;
  2807. end;
  2808.  
  2809. {$ENDIF}
  2810.  
  2811. function TOleUILinkInfo.GetNextLink(dwLink: Longint): Longint;
  2812. begin
  2813.   if dwLink = 0 then Result := Longint(FRichEdit)
  2814.   else Result := 0;
  2815. end;
  2816.  
  2817. function TOleUILinkInfo.SetLinkUpdateOptions(dwLink: Longint;
  2818.   dwUpdateOpt: Longint): HResult;
  2819. begin
  2820.   Result := FOleLink.SetUpdateOptions(dwUpdateOpt);
  2821.   if Succeeded(Result) then FRichEdit.Modified := True;
  2822. end;
  2823.  
  2824. function TOleUILinkInfo.GetLinkUpdateOptions(dwLink: Longint;
  2825.   var dwUpdateOpt: Longint): HResult;
  2826. begin
  2827.   Result := FOleLink.GetUpdateOptions(dwUpdateOpt);
  2828. end;
  2829.  
  2830. function TOleUILinkInfo.SetLinkSource(dwLink: Longint; pszDisplayName: PChar;
  2831.   lenFileName: Longint; var chEaten: Longint;
  2832.   fValidateSource: BOOL): HResult;
  2833. var
  2834.   DisplayName: string;
  2835.   Buffer: array[0..255] of WideChar;
  2836. begin
  2837.   Result := E_FAIL;
  2838.   if fValidateSource then begin
  2839.     DisplayName := pszDisplayName;
  2840.     if Succeeded(FOleLink.SetSourceDisplayName(StringToWideChar(DisplayName,
  2841.       Buffer, SizeOf(Buffer) div 2))) then
  2842.     begin
  2843.       chEaten := Length(DisplayName);
  2844.       try
  2845.         OleCheck(FReObject.poleobj.Update);
  2846.       except
  2847.         Application.HandleException(FRichEdit);
  2848.       end;
  2849.       Result := S_OK;
  2850.     end;
  2851.   end
  2852.   else LinkError(SInvalidLinkSource);
  2853. end;
  2854.  
  2855. function TOleUILinkInfo.GetLinkSource(dwLink: Longint; var pszDisplayName: PChar;
  2856.   var lenFileName: Longint; var pszFullLinkType: PChar;
  2857.   var pszShortLinkType: PChar; var fSourceAvailable: BOOL;
  2858.   var fIsSelected: BOOL): HResult;
  2859. var
  2860.   Moniker: IMoniker;
  2861. begin
  2862.   if @pszDisplayName <> nil then
  2863.     pszDisplayName := CoAllocCStr(GetDisplayNameStr(FOleLink));
  2864.   if @lenFileName <> nil then begin
  2865.     lenFileName := 0;
  2866.     FOleLink.GetSourceMoniker(Moniker);
  2867.     if Moniker <> nil then begin
  2868.       lenFileName := OleStdGetLenFilePrefixOfMoniker(Moniker);
  2869.       ReleaseObject(Moniker);
  2870.     end;
  2871.   end;
  2872.   if @pszFullLinkType <> nil then
  2873.     pszFullLinkType := CoAllocCStr(GetFullNameStr(FReObject.poleobj));
  2874.   if @pszShortLinkType <> nil then
  2875.     pszShortLinkType := CoAllocCStr(GetShortNameStr(FReObject.poleobj));
  2876.   Result := S_OK;
  2877. end;
  2878.  
  2879. function TOleUILinkInfo.OpenLinkSource(dwLink: Longint): HResult;
  2880. begin
  2881.   try
  2882.     OleCheck(FReObject.poleobj.DoVerb(OLEIVERB_SHOW, nil, FReObject.polesite,
  2883.       0, FRichEdit.Handle, FRichEdit.ClientRect));
  2884.   except
  2885.     Application.HandleException(FRichEdit);
  2886.   end;
  2887.   Result := S_OK;
  2888. end;
  2889.  
  2890. function TOleUILinkInfo.UpdateLink(dwLink: Longint; fErrorMessage: BOOL;
  2891.   fErrorAction: BOOL): HResult;
  2892. begin
  2893.   try
  2894.     OleCheck(FReObject.poleobj.Update);
  2895.   except
  2896.     Application.HandleException(FRichEdit);
  2897.   end;
  2898.   Result := S_OK;
  2899. end;
  2900.  
  2901. function TOleUILinkInfo.CancelLink(dwLink: Longint): HResult;
  2902. begin
  2903.   LinkError(SCannotBreakLink);
  2904.   Result := E_NOTIMPL;
  2905. end;
  2906.  
  2907. function TOleUILinkInfo.GetLastUpdate(dwLink: Longint;
  2908.   var LastUpdate: TFileTime): HResult;
  2909. begin
  2910.   Result := S_OK;
  2911. end;
  2912.  
  2913. { Get RichEdit OLE interface }
  2914.  
  2915. function GetRichEditOle(Wnd: HWnd; var RichEditOle): Boolean;
  2916. begin
  2917.   Result := SendMessage(Wnd, EM_GETOLEINTERFACE, 0, Longint(@RichEditOle)) <> 0;
  2918. end;
  2919.  
  2920. { TRichEditStrings }
  2921.  
  2922. const
  2923.   ReadError  = $0001;
  2924.   WriteError = $0002;
  2925.   NoError    = $0000;
  2926.  
  2927. type
  2928.   TRichEditStrings = class(TStrings)
  2929.   private
  2930.     RichEdit: TRxCustomRichEdit;
  2931.     FFormat: TRichStreamFormat;
  2932.     FMode: TRichStreamModes;
  2933.     FConverter: TConversion;
  2934.     procedure EnableChange(const Value: Boolean);
  2935.   protected
  2936.     function Get(Index: Integer): string; override;
  2937.     function GetCount: Integer; override;
  2938.     procedure Put(Index: Integer; const S: string); override;
  2939.     procedure SetUpdateState(Updating: Boolean); override;
  2940.     procedure SetTextStr(const Value: string); override;
  2941.   public
  2942.     destructor Destroy; override;
  2943.     procedure Clear; override;
  2944.     procedure AddStrings(Strings: TStrings); override;
  2945.     procedure Delete(Index: Integer); override;
  2946.     procedure Insert(Index: Integer; const S: string); override;
  2947.     procedure LoadFromFile(const FileName: string); override;
  2948.     procedure LoadFromStream(Stream: TStream); override;
  2949.     procedure SaveToFile(const FileName: string); override;
  2950.     procedure SaveToStream(Stream: TStream); override;
  2951.     property Format: TRichStreamFormat read FFormat write FFormat;
  2952.     property Mode: TRichStreamModes read FMode write FMode;
  2953.   end;
  2954.  
  2955. destructor TRichEditStrings.Destroy;
  2956. begin
  2957.   FConverter.Free;
  2958.   inherited Destroy;
  2959. end;
  2960.  
  2961. procedure TRichEditStrings.AddStrings(Strings: TStrings);
  2962. var
  2963.   SelChange: TNotifyEvent;
  2964. begin
  2965.   SelChange := RichEdit.OnSelectionChange;
  2966.   RichEdit.OnSelectionChange := nil;
  2967.   try
  2968.     inherited AddStrings(Strings);
  2969.   finally
  2970.     RichEdit.OnSelectionChange := SelChange;
  2971.   end;
  2972. end;
  2973.  
  2974. function TRichEditStrings.GetCount: Integer;
  2975. begin
  2976.   with RichEdit do begin
  2977.     Result := SendMessage(Handle, EM_GETLINECOUNT, 0, 0);
  2978.     if GetLineLength(GetLineIndex(Result - 1)) = 0 then Dec(Result);
  2979.   end;
  2980. end;
  2981.  
  2982. function TRichEditStrings.Get(Index: Integer): string;
  2983. var
  2984.   Text: array[0..4095] of Char;
  2985.   L: Integer;
  2986. begin
  2987.   Word((@Text)^) := SizeOf(Text);
  2988.   L := SendMessage(RichEdit.Handle, EM_GETLINE, Index, Longint(@Text));
  2989.   if (Text[L - 2] = #13) and (Text[L - 1] = #10) then Dec(L, 2)
  2990.   else if (RichEditVersion >= 2) and (Text[L - 1] = #13) then Dec(L);
  2991.   SetString(Result, Text, L);
  2992. end;
  2993.  
  2994. procedure TRichEditStrings.Put(Index: Integer; const S: string);
  2995. var
  2996.   Selection: TCharRange;
  2997. begin
  2998.   if Index >= 0 then
  2999.   begin
  3000.     Selection.cpMin := RichEdit.GetLineIndex(Index);
  3001.     if Selection.cpMin <> -1 then begin
  3002.       Selection.cpMax := Selection.cpMin +
  3003.         RichEdit.GetLineLength(Selection.cpMin);
  3004.       SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
  3005.       RichEdit.FLinesUpdating := True;
  3006.       try
  3007.         SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
  3008.       finally
  3009.         RichEdit.FLinesUpdating := False;
  3010.       end;
  3011.     end;
  3012.   end;
  3013. end;
  3014.  
  3015. procedure TRichEditStrings.Insert(Index: Integer; const S: string);
  3016. var
  3017.   L: Integer;
  3018.   Selection: TCharRange;
  3019.   Fmt: PChar;
  3020.   Str: string;
  3021. begin
  3022.   if Index >= 0 then begin
  3023.     Selection.cpMin := RichEdit.GetLineIndex(Index);
  3024.     if Selection.cpMin >= 0 then begin
  3025.       if RichEditVersion = 1 then Fmt := '%s'#13#10
  3026.       else Fmt := '%s'#13;
  3027.     end
  3028.     else begin
  3029.       Selection.cpMin := RichEdit.GetLineIndex(Index - 1);
  3030.       if Selection.cpMin < 0 then Exit;
  3031.       L := RichEdit.GetLineLength(Selection.cpMin);
  3032.       if L = 0 then Exit;
  3033.       Inc(Selection.cpMin, L);
  3034.       if RichEditVersion = 1 then Fmt := #13#10'%s'
  3035.       else Fmt := #13'%s';
  3036.     end;
  3037.     Selection.cpMax := Selection.cpMin;
  3038.     SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
  3039.     Str := SysUtils.Format(Fmt, [S]);
  3040.     RichEdit.FLinesUpdating := True;
  3041.     try
  3042.       SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(Str)));
  3043.     finally
  3044.       RichEdit.FLinesUpdating := False;
  3045.     end;
  3046.     if RichEditVersion = 1 then
  3047.       if RichEdit.SelStart <> (Selection.cpMax + Length(Str)) then
  3048.         raise EOutOfResources.Create(ResStr(sRichEditInsertError));
  3049.   end;
  3050. end;
  3051.  
  3052. procedure TRichEditStrings.Delete(Index: Integer);
  3053. const
  3054.   Empty: PChar = '';
  3055. var
  3056.   Selection: TCharRange;
  3057. begin
  3058.   if Index < 0 then Exit;
  3059.   Selection.cpMin := RichEdit.GetLineIndex(Index);
  3060.   if Selection.cpMin <> -1 then begin
  3061.     Selection.cpMax := RichEdit.GetLineIndex(Index + 1);
  3062.     if Selection.cpMax = -1 then
  3063.       Selection.cpMax := Selection.cpMin +
  3064.         RichEdit.GetLineLength(Selection.cpMin);
  3065.     SendMessage(RichEdit.Handle, EM_EXSETSEL, 0, Longint(@Selection));
  3066.     RichEdit.FLinesUpdating := True;
  3067.     try
  3068.       SendMessage(RichEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
  3069.     finally
  3070.       RichEdit.FLinesUpdating := False;
  3071.     end;
  3072.   end;
  3073. end;
  3074.  
  3075. procedure TRichEditStrings.Clear;
  3076. begin
  3077.   RichEdit.Clear;
  3078. end;
  3079.  
  3080. procedure TRichEditStrings.SetUpdateState(Updating: Boolean);
  3081. begin
  3082.   if RichEdit.Showing then
  3083.     SendMessage(RichEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  3084.   if not Updating then begin
  3085.     RichEdit.Refresh;
  3086.     RichEdit.Perform(CM_TEXTCHANGED, 0, 0);
  3087.   end;
  3088. end;
  3089.  
  3090. procedure TRichEditStrings.EnableChange(const Value: Boolean);
  3091. var
  3092.   EventMask: Longint;
  3093. begin
  3094.   with RichEdit do begin
  3095.     EventMask := SendMessage(Handle, EM_GETEVENTMASK, 0, 0);
  3096.     if Value then
  3097.       EventMask := EventMask or ENM_CHANGE
  3098.     else
  3099.       EventMask := EventMask and not ENM_CHANGE;
  3100.     SendMessage(Handle, EM_SETEVENTMASK, 0, EventMask);
  3101.   end;
  3102. end;
  3103.  
  3104. procedure TRichEditStrings.SetTextStr(const Value: string);
  3105. begin
  3106.   EnableChange(False);
  3107.   try
  3108.     inherited SetTextStr(Value);
  3109.   finally
  3110.     EnableChange(True);
  3111.   end;
  3112. end;
  3113.  
  3114. function AdjustLineBreaks(Dest, Source: PChar): Integer; assembler;
  3115. asm
  3116.         PUSH    ESI
  3117.         PUSH    EDI
  3118.         MOV     EDI,EAX
  3119.         MOV     ESI,EDX
  3120.         MOV     EDX,EAX
  3121.         CLD
  3122. @@1:    LODSB
  3123. @@2:    OR      AL,AL
  3124.         JE      @@4
  3125.         CMP     AL,0AH
  3126.         JE      @@3
  3127.         STOSB
  3128.         CMP     AL,0DH
  3129.         JNE     @@1
  3130.         MOV     AL,0AH
  3131.         STOSB
  3132.         LODSB
  3133.         CMP     AL,0AH
  3134.         JE      @@1
  3135.         JMP     @@2
  3136. @@3:    MOV     EAX,0A0DH
  3137.         STOSW
  3138.         JMP     @@1
  3139. @@4:    STOSB
  3140.         LEA     EAX,[EDI-1]
  3141.         SUB     EAX,EDX
  3142.         POP     EDI
  3143.         POP     ESI
  3144. end;
  3145.  
  3146. function StreamSave(dwCookie: Longint; pbBuff: PByte;
  3147.   cb: Longint; var pcb: Longint): Longint; stdcall;
  3148. var
  3149.   StreamInfo: PRichEditStreamInfo;
  3150. begin
  3151.   Result := NoError;
  3152.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  3153.   try
  3154.     pcb := 0;
  3155.     if StreamInfo^.Converter <> nil then
  3156.       pcb := StreamInfo^.Converter.ConvertWriteStream(StreamInfo^.Stream, PChar(pbBuff), cb);
  3157.   except
  3158.     Result := WriteError;
  3159.   end;
  3160. end;
  3161.  
  3162. function StreamLoad(dwCookie: Longint; pbBuff: PByte;
  3163.   cb: Longint; var pcb: Longint): Longint; stdcall;
  3164. var
  3165.   Buffer, pBuff: PChar;
  3166.   StreamInfo: PRichEditStreamInfo;
  3167. begin
  3168.   Result := NoError;
  3169.   StreamInfo := PRichEditStreamInfo(Pointer(dwCookie));
  3170.   Buffer := StrAlloc(cb + 1);
  3171.   try
  3172.     cb := cb div 2;
  3173.     pcb := 0;
  3174.     pBuff := Buffer + cb;
  3175.     try
  3176.       if StreamInfo^.Converter <> nil then
  3177.         pcb := StreamInfo^.Converter.ConvertReadStream(StreamInfo^.Stream, pBuff, cb);
  3178.       if pcb > 0 then
  3179.       begin
  3180.         pBuff[pcb] := #0;
  3181.         if pBuff[pcb - 1] = #13 then pBuff[pcb - 1] := #0;
  3182.         pcb := AdjustLineBreaks(Buffer, pBuff);
  3183.         Move(Buffer^, pbBuff^, pcb);
  3184.       end;
  3185.     except
  3186.       Result := ReadError;
  3187.     end;
  3188.   finally
  3189.     StrDispose(Buffer);
  3190.   end;
  3191. end;
  3192.  
  3193. procedure TRichEditStrings.LoadFromStream(Stream: TStream);
  3194. var
  3195.   EditStream: TEditStream;
  3196.   Position: Longint;
  3197.   TextType: Longint;
  3198.   StreamInfo: TRichEditStreamInfo;
  3199.   Converter: TConversion;
  3200. begin
  3201.   StreamInfo.Stream := Stream;
  3202.   if FConverter <> nil then Converter := FConverter
  3203.   else Converter := RichEdit.DefaultConverter.Create;
  3204.   StreamInfo.Converter := Converter;
  3205.   try
  3206.     with EditStream do
  3207.     begin
  3208.       dwCookie := Longint(Pointer(@StreamInfo));
  3209.       pfnCallBack := @StreamLoad;
  3210.       dwError := 0;
  3211.     end;
  3212.     Position := Stream.Position;
  3213.     case FFormat of
  3214.       sfDefault:
  3215.         if RichEdit.PlainText then TextType := SF_TEXT
  3216.         else TextType := SF_RTF;
  3217.       sfRichText: TextType := SF_RTF;
  3218.       else {sfPlainText} TextType := SF_TEXT;
  3219.     end;
  3220.     if TextType = SF_RTF then begin
  3221.       if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF;
  3222.     end;
  3223.     if TextType = SF_TEXT then begin
  3224.       if (smUnicode in Mode) and (RichEditVersion > 1) then
  3225.         TextType := TextType or SF_UNICODE;
  3226.     end;
  3227.     if smSelection in Mode then TextType := TextType or SFF_SELECTION;
  3228.     SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  3229.     if (EditStream.dwError <> 0) then begin
  3230.       Stream.Position := Position;
  3231.       if (TextType and SF_RTF = SF_RTF) then TextType := SF_TEXT
  3232.       else TextType := SF_RTF;
  3233.       SendMessage(RichEdit.Handle, EM_STREAMIN, TextType, Longint(@EditStream));
  3234.       if EditStream.dwError <> 0 then
  3235.         raise EOutOfResources.Create(ResStr(sRichEditLoadFail));
  3236.     end;
  3237.     RichEdit.SetSelection(0, 0, True);
  3238.   finally
  3239.     if FConverter = nil then Converter.Free;
  3240.   end;
  3241. end;
  3242.  
  3243. procedure TRichEditStrings.SaveToStream(Stream: TStream);
  3244. var
  3245.   EditStream: TEditStream;
  3246.   TextType: Longint;
  3247.   StreamInfo: TRichEditStreamInfo;
  3248.   Converter: TConversion;
  3249. begin
  3250.   if FConverter <> nil then Converter := FConverter
  3251.   else Converter := RichEdit.DefaultConverter.Create;
  3252.   StreamInfo.Stream := Stream;
  3253.   StreamInfo.Converter := Converter;
  3254.   try
  3255.     with EditStream do
  3256.     begin
  3257.       dwCookie := Longint(Pointer(@StreamInfo));
  3258.       pfnCallBack := @StreamSave;
  3259.       dwError := 0;
  3260.     end;
  3261.     case FFormat of
  3262.       sfDefault:
  3263.         if RichEdit.PlainText then TextType := SF_TEXT
  3264.         else TextType := SF_RTF;
  3265.       sfRichText: TextType := SF_RTF;
  3266.       else {sfPlainText} TextType := SF_TEXT;
  3267.     end;
  3268.     if TextType = SF_RTF then begin
  3269.       if smNoObjects in Mode then TextType := SF_RTFNOOBJS;
  3270.       if smPlainRtf in Mode then TextType := TextType or SFF_PLAINRTF;
  3271.     end
  3272.     else if TextType = SF_TEXT then begin
  3273.       if (smUnicode in Mode) and (RichEditVersion > 1) then
  3274.         TextType := TextType or SF_UNICODE;
  3275.     end;
  3276.     if smSelection in Mode then TextType := TextType or SFF_SELECTION;
  3277.     SendMessage(RichEdit.Handle, EM_STREAMOUT, TextType, Longint(@EditStream));
  3278.     if EditStream.dwError <> 0 then
  3279.       raise EOutOfResources.Create(ResStr(sRichEditSaveFail));
  3280.   finally
  3281.     if FConverter = nil then Converter.Free;
  3282.   end;
  3283. end;
  3284.  
  3285. procedure TRichEditStrings.LoadFromFile(const FileName: string);
  3286. var
  3287.   Ext: string;
  3288.   Convert: PRichConversionFormat;
  3289.   SaveFormat: TRichStreamFormat;
  3290. begin
  3291. {$IFNDEF VER90}
  3292.   Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
  3293. {$ELSE}
  3294.   Ext := LowerCase(ExtractFileExt(Filename));
  3295. {$ENDIF}
  3296.   System.Delete(Ext, 1, 1);
  3297.   Convert := ConversionFormatList;
  3298.   while Convert <> nil do
  3299.     with Convert^ do
  3300.       if Extension <> Ext then Convert := Next
  3301.       else Break;
  3302.   if (FConverter = nil) and (Convert <> nil) then
  3303.     FConverter := Convert^.ConversionClass.Create;
  3304.   try
  3305.     SaveFormat := Format;
  3306.     try
  3307.       if Convert <> nil then begin
  3308.         if Convert^.PlainText then FFormat := sfPlainText
  3309.         else FFormat := sfRichText;
  3310.       end;
  3311.       inherited LoadFromFile(FileName);
  3312.     finally
  3313.       FFormat := SaveFormat;
  3314.     end;
  3315.   except
  3316.     FConverter.Free;
  3317.     FConverter := nil;
  3318.     raise;
  3319.   end;
  3320. end;
  3321.  
  3322. procedure TRichEditStrings.SaveToFile(const FileName: string);
  3323. var
  3324.   Ext: string;
  3325.   Convert: PRichConversionFormat;
  3326.   SaveFormat: TRichStreamFormat;
  3327. begin
  3328. {$IFNDEF VER90}
  3329.   Ext := AnsiLowerCaseFileName(ExtractFileExt(Filename));
  3330. {$ELSE}
  3331.   Ext := LowerCase(ExtractFileExt(Filename));
  3332. {$ENDIF}
  3333.   System.Delete(Ext, 1, 1);
  3334.   Convert := ConversionFormatList;
  3335.   while Convert <> nil do
  3336.     with Convert^ do
  3337.       if Extension <> Ext then Convert := Next
  3338.       else Break;
  3339.   if (FConverter = nil) and (Convert <> nil) then
  3340.     FConverter := Convert^.ConversionClass.Create;
  3341.   try
  3342.     SaveFormat := Format;
  3343.     try
  3344.       if Convert <> nil then begin
  3345.         if Convert^.PlainText then FFormat := sfPlainText
  3346.         else FFormat := sfRichText;
  3347.       end;
  3348.       inherited SaveToFile(FileName);
  3349.     finally
  3350.       FFormat := SaveFormat;
  3351.     end;
  3352.   except
  3353.     FConverter.Free;
  3354.     FConverter := nil;
  3355.     raise;
  3356.   end;
  3357. end;
  3358.  
  3359. { TOEMConversion }
  3360.  
  3361. function TOEMConversion.ConvertReadStream(Stream: TStream; Buffer: PChar;
  3362.   BufSize: Integer): Integer;
  3363. var
  3364.   Mem: TMemoryStream;
  3365. begin
  3366.   Mem := TMemoryStream.Create;
  3367.   try
  3368.     Mem.SetSize(BufSize);
  3369.     Result := inherited ConvertReadStream(Stream, PChar(Mem.Memory), BufSize);
  3370.     OemToCharBuff(PChar(Mem.Memory), Buffer, Result);
  3371.   finally
  3372.     Mem.Free;
  3373.   end;
  3374. end;
  3375.  
  3376. function TOEMConversion.ConvertWriteStream(Stream: TStream; Buffer: PChar;
  3377.   BufSize: Integer): Integer;
  3378. var
  3379.   Mem: TMemoryStream;
  3380. begin
  3381.   Mem := TMemoryStream.Create;
  3382.   try
  3383.     Mem.SetSize(BufSize);
  3384.     CharToOemBuff(Buffer, PChar(Mem.Memory), BufSize);
  3385.     Result := inherited ConvertWriteStream(Stream, PChar(Mem.Memory), BufSize);
  3386.   finally
  3387.     Mem.Free;
  3388.   end;
  3389. end;
  3390.  
  3391. { TRxCustomRichEdit }
  3392.  
  3393. constructor TRxCustomRichEdit.Create(AOwner: TComponent);
  3394. var
  3395.   DC: HDC;
  3396. begin
  3397.   inherited Create(AOwner);
  3398.   ControlStyle := ControlStyle - [csSetCaption];
  3399.   FSelAttributes := TRxTextAttributes.Create(Self, atSelected);
  3400.   FDefAttributes := TRxTextAttributes.Create(Self, atDefaultText);
  3401.   FWordAttributes := TRxTextAttributes.Create(Self, atWord);
  3402.   FParagraph := TRxParaAttributes.Create(Self);
  3403.   FRichEditStrings := TRichEditStrings.Create;
  3404.   TRichEditStrings(FRichEditStrings).RichEdit := Self;
  3405.   TabStop := True;
  3406.   Width := 185;
  3407.   Height := 89;
  3408.   AutoSize := False;
  3409. {$IFDEF RX_D4}
  3410.   DoubleBuffered := False;
  3411. {$ENDIF}
  3412.   FAllowObjects := True;
  3413. {$IFDEF RX_D3}
  3414.   FAllowInPlace := True;
  3415. {$ENDIF}
  3416.   FAutoVerbMenu := True;
  3417.   FHideSelection := True;
  3418.   FHideScrollBars := True;
  3419.   ScrollBars := ssBoth;
  3420.   FSelectionBar := True;
  3421.   FLangOptions := [rlAutoFont];
  3422.   DC := GetDC(0);
  3423.   FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
  3424.   ReleaseDC(0, DC);
  3425.   DefaultConverter := TConversion;
  3426.   FOldParaAlignment := TParaAlignment(Alignment);
  3427.   FUndoLimit := 100;
  3428.   FAutoURLDetect := True;
  3429.   FWordSelection := True;
  3430.   with FClickRange do begin
  3431.     cpMin := -1;
  3432.     cpMax := -1;
  3433.   end;
  3434.   FCallback := TRichEditOleCallback.Create(Self);
  3435. {$IFDEF RX_D4}
  3436.   Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
  3437. {$ENDIF}
  3438. end;
  3439.  
  3440. destructor TRxCustomRichEdit.Destroy;
  3441. begin
  3442.   FLastFind := nil;
  3443.   FSelAttributes.Free;
  3444.   FDefAttributes.Free;
  3445.   FWordAttributes.Free;
  3446.   FParagraph.Free;
  3447.   FRichEditStrings.Free;
  3448.   FMemStream.Free;
  3449.   FPopupVerbMenu.Free;
  3450.   FFindDialog.Free;
  3451.   FReplaceDialog.Free;
  3452.   inherited Destroy;
  3453.   { be sure that callback object is destroyed after inherited Destroy }
  3454.   TRichEditOleCallback(FCallback).Free;
  3455. end;
  3456.  
  3457. procedure TRxCustomRichEdit.Clear;
  3458. begin
  3459.   CloseObjects;
  3460.   inherited Clear;
  3461.   Modified := False;
  3462. end;
  3463.  
  3464. procedure TRxCustomRichEdit.CreateParams(var Params: TCreateParams);
  3465. const
  3466.   HideScrollBars: array[Boolean] of DWORD = (ES_DISABLENOSCROLL, 0);
  3467.   HideSelections: array[Boolean] of DWORD = (ES_NOHIDESEL, 0);
  3468.   WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
  3469.   SelectionBars: array[Boolean] of DWORD = (0, ES_SELECTIONBAR);
  3470. begin
  3471.   inherited CreateParams(Params);
  3472.   case RichEditVersion of
  3473.     1: CreateSubClass(Params, RICHEDIT_CLASS10A);
  3474.     else CreateSubClass(Params, RICHEDIT_CLASS);
  3475.   end;
  3476.   with Params do begin
  3477.     Style := (Style and not (WS_HSCROLL or WS_VSCROLL)) or ES_SAVESEL or
  3478.       (WS_CLIPSIBLINGS or WS_CLIPCHILDREN);
  3479.     { NOTE: WS_CLIPCHILDREN and WS_CLIPSIBLINGS are essential otherwise }
  3480.     { once the object is inserted you see some painting problems.       }
  3481.     Style := Style and not (WS_HSCROLL or WS_VSCROLL);
  3482.     if ScrollBars in [ssVertical, ssBoth] then
  3483.       Style := Style or WS_VSCROLL;
  3484.     if (ScrollBars in [ssHorizontal, ssBoth]) and not WordWrap then
  3485.       Style := Style or WS_HSCROLL;
  3486.     Style := Style or HideScrollBars[FHideScrollBars] or
  3487.       SelectionBars[FSelectionBar] or HideSelections[FHideSelection] and
  3488.       not WordWraps[WordWrap];
  3489.     WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  3490.   end;
  3491. end;
  3492.  
  3493. procedure TRxCustomRichEdit.CreateWnd;
  3494. var
  3495.   StreamFmt: TRichStreamFormat;
  3496.   Mode: TRichStreamModes;
  3497.   DesignMode: Boolean;
  3498.   Mask: Longint;
  3499. begin
  3500.   StreamFmt := TRichEditStrings(Lines).Format;
  3501.   Mode := TRichEditStrings(Lines).Mode;
  3502.   inherited CreateWnd;
  3503. {$IFNDEF VER90}
  3504.   if (SysLocale.FarEast) and not (SysLocale.PriLangID = LANG_JAPANESE) then
  3505.     Font.Charset := GetDefFontCharSet;
  3506. {$ENDIF}
  3507.   Mask := ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_PROTECTED;
  3508.   if RichEditVersion >= 2 then Mask := Mask or ENM_LINK;
  3509.   SendMessage(Handle, EM_SETEVENTMASK, 0, Mask);
  3510.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color));
  3511. {$IFDEF RX_D3}
  3512.   DoSetMaxLength(MaxLength);
  3513. {$ENDIF}
  3514.   SetWordSelection(FWordSelection);
  3515.   if RichEditVersion >= 2 then begin
  3516.     SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0);
  3517.     FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, FUndoLimit, 0);
  3518.     UpdateTextModes(PlainText);
  3519.     SetLangOptions(FLangOptions);
  3520.   end;
  3521.   if FAllowObjects then begin
  3522.     SendMessage(Handle, EM_SETOLECALLBACK, 0,
  3523.       LPARAM(TRichEditOleCallback(FCallback) as IRichEditOleCallback));
  3524.     GetRichEditOle(Handle, FRichEditOle);
  3525.     UpdateHostNames;
  3526.   end;
  3527.   if FMemStream <> nil then begin
  3528.     FMemStream.ReadBuffer(DesignMode, SizeOf(DesignMode));
  3529.     if DesignMode then begin
  3530.       TRichEditStrings(Lines).Format := sfPlainText;
  3531.       TRichEditStrings(Lines).Mode := [];
  3532.     end;
  3533.     try
  3534.       Lines.LoadFromStream(FMemStream);
  3535.       FMemStream.Free;
  3536.       FMemStream := nil;
  3537.     finally
  3538.       TRichEditStrings(Lines).Format := StreamFmt;
  3539.       TRichEditStrings(Lines).Mode := Mode;
  3540.     end;
  3541.   end;
  3542.   if RichEditVersion < 2 then
  3543.     SendMessage(Handle, WM_SETFONT, 0, 0);
  3544.   Modified := FModified;
  3545. end;
  3546.  
  3547. procedure TRxCustomRichEdit.DestroyWnd;
  3548. var
  3549.   StreamFmt: TRichStreamFormat;
  3550.   Mode: TRichStreamModes;
  3551.   DesignMode: Boolean;
  3552. begin
  3553.   FModified := Modified;
  3554.   FMemStream := TMemoryStream.Create;
  3555.   StreamFmt := TRichEditStrings(Lines).Format;
  3556.   Mode := TRichEditStrings(Lines).Mode;
  3557.   DesignMode := (csDesigning in ComponentState);
  3558.   FMemStream.WriteBuffer(DesignMode, SizeOf(DesignMode));
  3559.   if DesignMode then begin
  3560.     TRichEditStrings(Lines).Format := sfPlainText;
  3561.     TRichEditStrings(Lines).Mode := [];
  3562.   end;
  3563.   try
  3564.     Lines.SaveToStream(FMemStream);
  3565.     FMemStream.Position := 0;
  3566.   finally
  3567.     TRichEditStrings(Lines).Format := StreamFmt;
  3568.     TRichEditStrings(Lines).Mode := Mode;
  3569.   end;
  3570.   inherited DestroyWnd;
  3571. end;
  3572.  
  3573. procedure TRxCustomRichEdit.SetAllowObjects(Value: Boolean);
  3574. begin
  3575.   if FAllowObjects <> Value then begin
  3576.     FAllowObjects := Value;
  3577.     RecreateWnd;    
  3578.   end;
  3579. end;
  3580.  
  3581. procedure TRxCustomRichEdit.UpdateHostNames;
  3582. var
  3583.   AppName: string;
  3584. begin
  3585.   if HandleAllocated and Assigned(FRichEditOle) then begin
  3586.     AppName := Application.Title;
  3587.     if Trim(AppName) = '' then
  3588.       AppName := ExtractFileName(Application.ExeName);
  3589.     if Trim(Title) = '' then
  3590.       IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(AppName))
  3591.     else
  3592.       IRichEditOle(FRichEditOle).SetHostNames(PChar(AppName), PChar(Title));
  3593.   end;
  3594. end;
  3595.  
  3596. procedure TRxCustomRichEdit.SetTitle(const Value: string);
  3597. begin
  3598.   if FTitle <> Value then begin
  3599.     FTitle := Value;
  3600.     UpdateHostNames;
  3601.   end;
  3602. end;
  3603.  
  3604. function TRxCustomRichEdit.GetPopupMenu: TPopupMenu;
  3605. var
  3606.   EnumOleVerb: IEnumOleVerb;
  3607.   OleVerb: TOleVerb;
  3608.   Item: TMenuItem;
  3609.   ReObject: TReObject;
  3610. begin
  3611.   FPopupVerbMenu.Free;
  3612.   FPopupVerbMenu := nil;
  3613.   Result := inherited GetPopupMenu;
  3614.   if FAutoVerbMenu and (SelectionType = [stObject]) and
  3615.     Assigned(FRichEditOle) then
  3616.   begin
  3617.     FillChar(ReObject, SizeOf(ReObject), 0);
  3618.     ReObject.cbStruct := SizeOf(ReObject);
  3619.     if Succeeded(IRichEditOle(FRichEditOle).GetObject(
  3620.       Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ)) then
  3621.     try
  3622.       if Assigned(ReObject.poleobj) and
  3623.         (ReObject.dwFlags and REO_INPLACEACTIVE = 0) then
  3624.       begin
  3625.         FPopupVerbMenu := TPopupMenu.Create(Self);
  3626.         if ReObject.poleobj.EnumVerbs(EnumOleVerb) = 0 then
  3627.         try
  3628.           while (EnumOleVerb.Next(1, OleVerb, nil) = 0) and
  3629.             (OleVerb.lVerb >= 0) and
  3630.             (OleVerb.grfAttribs and OLEVERBATTRIB_ONCONTAINERMENU <> 0) do
  3631.           begin
  3632.             Item := TMenuItem.Create(FPopupVerbMenu);
  3633.             Item.Caption := WideCharToString(OleVerb.lpszVerbName);
  3634.             Item.Tag := OleVerb.lVerb;
  3635.             Item.Default := (OleVerb.lVerb = OLEIVERB_PRIMARY);
  3636.             Item.OnClick := PopupVerbClick;
  3637.             FPopupVerbMenu.Items.Add(Item);
  3638.           end;
  3639.         finally
  3640.           ReleaseObject(EnumOleVerb);
  3641.         end;
  3642.         if (Result <> nil) and (Result.Items.Count > 0) then begin
  3643.           Item := TMenuItem.Create(FPopupVerbMenu);
  3644.           Item.Caption := '-';
  3645.           Result.Items.Add(Item);
  3646.           Item := TMenuItem.Create(FPopupVerbMenu);
  3647.           Item.Caption := Format(ResStr(SPropDlgCaption),
  3648.             [GetFullNameStr(ReObject.poleobj)]);
  3649.           Item.OnClick := ObjectPropsClick;
  3650.           Result.Items.Add(Item);
  3651.           if FPopupVerbMenu.Items.Count > 0 then begin
  3652.             FPopupVerbMenu.Items.Caption := GetFullNameStr(ReObject.poleobj);
  3653.             Result.Items.Add(FPopupVerbMenu.Items);
  3654.           end;
  3655.         end
  3656.         else if FPopupVerbMenu.Items.Count > 0 then begin
  3657.           Item := TMenuItem.Create(FPopupVerbMenu);
  3658.           Item.Caption := Format(ResStr(SPropDlgCaption),
  3659.             [GetFullNameStr(ReObject.poleobj)]);
  3660.           Item.OnClick := ObjectPropsClick;
  3661.           FPopupVerbMenu.Items.Insert(0, Item);
  3662.           Result := FPopupVerbMenu;
  3663.         end;
  3664.       end;
  3665.     finally
  3666.       ReleaseObject(ReObject.poleobj);
  3667.     end;
  3668.   end;
  3669. end;
  3670.  
  3671. procedure TRxCustomRichEdit.PopupVerbClick(Sender: TObject);
  3672. var
  3673.   ReObject: TReObject;
  3674. begin
  3675.   if Assigned(FRichEditOle) then begin
  3676.     FillChar(ReObject, SizeOf(ReObject), 0);
  3677.     ReObject.cbStruct := SizeOf(ReObject);
  3678.     if Succeeded(IRichEditOle(FRichEditOle).GetObject(
  3679.       Longint(REO_IOB_SELECTION), ReObject, REO_GETOBJ_POLEOBJ or
  3680.       REO_GETOBJ_POLESITE)) then
  3681.     try
  3682.       if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then
  3683.         OleCheck(ReObject.poleobj.DoVerb((Sender as TMenuItem).Tag, nil,
  3684.           ReObject.polesite, 0, Handle, ClientRect));
  3685.     finally
  3686.       ReleaseObject(ReObject.polesite);
  3687.       ReleaseObject(ReObject.poleobj);
  3688.     end;
  3689.   end;
  3690. end;
  3691.  
  3692. procedure TRxCustomRichEdit.ObjectPropsClick(Sender: TObject);
  3693. begin
  3694.   ObjectPropertiesDialog;
  3695. end;
  3696.  
  3697. procedure TRxCustomRichEdit.WMSetFont(var Message: TWMSetFont);
  3698. begin
  3699.   FDefAttributes.Assign(Font);
  3700. end;
  3701.  
  3702. procedure TRxCustomRichEdit.CMFontChanged(var Message: TMessage);
  3703. begin
  3704.   inherited;
  3705.   FDefAttributes.Assign(Font);
  3706. end;
  3707.  
  3708. procedure TRxCustomRichEdit.CreateWindowHandle(const Params: TCreateParams);
  3709. var
  3710.   Bounds: TRect;
  3711. begin
  3712.   Bounds := BoundsRect;
  3713.   inherited CreateWindowHandle(Params);
  3714.   if HandleAllocated then BoundsRect := Bounds;
  3715. end;
  3716.  
  3717. {$IFDEF RX_D3}
  3718. procedure TRxCustomRichEdit.DoSetMaxLength(Value: Integer);
  3719. begin
  3720.   { The rich edit control's default maximum amount of text is 32K }
  3721.   { Let's set it at 16M by default }
  3722.   if Value = 0 then Value := $FFFFFF;
  3723.   SendMessage(Handle, EM_EXLIMITTEXT, 0, Value);
  3724. end;
  3725. {$ENDIF}
  3726.  
  3727. function TRxCustomRichEdit.GetCaretPos: TPoint;
  3728. var
  3729.   CharRange: TCharRange;
  3730. begin
  3731.   SendMessage(Handle, EM_EXGETSEL, 0, Longint(@CharRange));
  3732.   Result.X := CharRange.cpMax;
  3733.   Result.Y := LineFromChar(Result.X);
  3734.   Dec(Result.X, GetLineIndex(-1));
  3735. end;
  3736.  
  3737. {$IFDEF RX_D3}
  3738. function TRxCustomRichEdit.GetSelLength: Integer;
  3739. begin
  3740.   with GetSelection do
  3741.     Result := cpMax - cpMin;
  3742. end;
  3743.  
  3744. function TRxCustomRichEdit.GetSelStart: Integer;
  3745. begin
  3746.   Result := GetSelection.cpMin;
  3747. end;
  3748.  
  3749. function TRxCustomRichEdit.GetSelText: string;
  3750. begin
  3751.   with GetSelection do
  3752.     Result := GetTextRange(cpMin, cpMax);
  3753. end;
  3754. {$ENDIF RX_D3}
  3755.  
  3756. function TRxCustomRichEdit.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
  3757. var
  3758.   S: string;
  3759. begin
  3760.   S := SelText;
  3761.   Result := Length(S);
  3762.   if BufSize < Length(S) then Result := BufSize;
  3763.   StrPLCopy(Buffer, S, Result);
  3764. end;
  3765.  
  3766. {$IFDEF RX_D4}
  3767. procedure TRxCustomRichEdit.CMBiDiModeChanged(var Message: TMessage);
  3768. var
  3769.   AParagraph: TParaFormat2;
  3770. begin
  3771.   HandleNeeded; { we REALLY need the handle for BiDi }
  3772.   inherited;
  3773.   Paragraph.GetAttributes(AParagraph);
  3774.   AParagraph.dwMask := PFM_ALIGNMENT;
  3775.   AParagraph.wAlignment := Ord(Alignment) + 1;
  3776.   Paragraph.SetAttributes(AParagraph);
  3777. end;
  3778. {$ENDIF}
  3779.  
  3780. procedure TRxCustomRichEdit.SetHideScrollBars(Value: Boolean);
  3781. begin
  3782.   if HideScrollBars <> Value then begin
  3783.     FHideScrollBars := Value;
  3784.     RecreateWnd;
  3785.   end;
  3786. end;
  3787.  
  3788. procedure TRxCustomRichEdit.SetSelectionBar(Value: Boolean);
  3789. begin
  3790.   if FSelectionBar <> Value then begin
  3791.     FSelectionBar := Value;
  3792.     RecreateWnd;
  3793.   end;
  3794. end;
  3795.  
  3796. procedure TRxCustomRichEdit.SetHideSelection(Value: Boolean);
  3797. begin
  3798.   if HideSelection <> Value then begin
  3799.     FHideSelection := Value;
  3800.     SendMessage(Handle, EM_HIDESELECTION, Ord(HideSelection), LPARAM(True));
  3801.   end;
  3802. end;
  3803.  
  3804. function TRxCustomRichEdit.GetAutoURLDetect: Boolean;
  3805. begin
  3806.   Result := FAutoURLDetect;
  3807.   if HandleAllocated and not (csDesigning in ComponentState) then begin
  3808.     if RichEditVersion >= 2 then
  3809.       Result := Boolean(SendMessage(Handle, EM_GETAUTOURLDETECT, 0, 0));
  3810.   end;
  3811. end;
  3812.  
  3813. procedure TRxCustomRichEdit.SetAutoURLDetect(Value: Boolean);
  3814. begin
  3815.   if Value <> FAutoURLDetect then begin
  3816.     FAutoURLDetect := Value;
  3817.     if HandleAllocated and (RichEditVersion >= 2) then
  3818.       SendMessage(Handle, EM_AUTOURLDETECT, Longint(FAutoURLDetect), 0);
  3819.   end;
  3820. end;
  3821.  
  3822. function TRxCustomRichEdit.GetWordSelection: Boolean;
  3823. begin
  3824.   Result := FWordSelection;
  3825.   if HandleAllocated then
  3826.     Result := (SendMessage(Handle, EM_GETOPTIONS, 0, 0) and
  3827.       ECO_AUTOWORDSELECTION) <> 0;
  3828. end;
  3829.  
  3830. procedure TRxCustomRichEdit.SetWordSelection(Value: Boolean);
  3831. var
  3832.   Options: LPARAM;
  3833. begin
  3834.   FWordSelection := Value;
  3835.   if HandleAllocated then begin
  3836.     Options := SendMessage(Handle, EM_GETOPTIONS, 0, 0);
  3837.     if Value then Options := Options or ECO_AUTOWORDSELECTION
  3838.     else Options := Options and not ECO_AUTOWORDSELECTION;
  3839.     SendMessage(Handle, EM_SETOPTIONS, ECOOP_SET, Options);
  3840.   end;
  3841. end;
  3842.  
  3843. const
  3844.   RichLangOptions: array[TRichLangOption] of DWORD = (IMF_AUTOKEYBOARD,
  3845.     IMF_AUTOFONT, IMF_IMECANCELCOMPLETE, IMF_IMEALWAYSSENDNOTIFY);
  3846.  
  3847. function TRxCustomRichEdit.GetLangOptions: TRichLangOptions;
  3848. var
  3849.   Flags: Longint;
  3850.   I: TRichLangOption;
  3851. begin
  3852.   Result := FLangOptions;
  3853.   if HandleAllocated and not (csDesigning in ComponentState) and
  3854.     (RichEditVersion >= 2) then
  3855.   begin
  3856.     Result := [];
  3857.     Flags := SendMessage(Handle, EM_GETLANGOPTIONS, 0, 0);
  3858.     for I := Low(TRichLangOption) to High(TRichLangOption) do
  3859.       if Flags and RichLangOptions[I] <> 0 then Include(Result, I);
  3860.   end;
  3861. end;
  3862.  
  3863. procedure TRxCustomRichEdit.SetLangOptions(Value: TRichLangOptions);
  3864. var
  3865.   Flags: DWORD;
  3866.   I: TRichLangOption;
  3867. begin
  3868.   FLangOptions := Value;
  3869.   if HandleAllocated and (RichEditVersion >= 2) then begin
  3870.     Flags := 0;
  3871.     for I := Low(TRichLangOption) to High(TRichLangOption) do
  3872.       if I in Value then Flags := Flags or RichLangOptions[I];
  3873.     SendMessage(Handle, EM_SETLANGOPTIONS, 0, LPARAM(Flags));
  3874.   end;
  3875. end;
  3876.  
  3877. procedure TRxCustomRichEdit.SetSelAttributes(Value: TRxTextAttributes);
  3878. begin
  3879.   FSelAttributes.Assign(Value);
  3880. end;
  3881.  
  3882. function TRxCustomRichEdit.GetCanRedo: Boolean;
  3883. begin
  3884.   Result := False;
  3885.   if HandleAllocated and (RichEditVersion >= 2) then
  3886.     Result := SendMessage(Handle, EM_CANREDO, 0, 0) <> 0;
  3887. end;
  3888.  
  3889. function TRxCustomRichEdit.GetCanPaste: Boolean;
  3890. begin
  3891.   Result := False;
  3892.   if HandleAllocated then
  3893.     Result := SendMessage(Handle, EM_CANPASTE, 0, 0) <> 0;
  3894. end;
  3895.  
  3896. {$IFNDEF RX_V110}
  3897. function TRxCustomRichEdit.GetCanUndo: Boolean;
  3898. begin
  3899.   Result := False;
  3900.   if HandleAllocated then
  3901.     Result := SendMessage(Handle, EM_CANUNDO, 0, 0) <> 0;
  3902. end;
  3903. {$ENDIF}
  3904.  
  3905. function TRxCustomRichEdit.GetRedoName: TUndoName;
  3906. begin
  3907.   Result := unUnknown;
  3908.   if (RichEditVersion >= 2) and HandleAllocated then
  3909.     Result := TUndoName(SendMessage(Handle, EM_GETREDONAME, 0, 0));
  3910. end;
  3911.  
  3912. function TRxCustomRichEdit.GetUndoName: TUndoName;
  3913. begin
  3914.   Result := unUnknown;
  3915.   if (RichEditVersion >= 2) and HandleAllocated then
  3916.     Result := TUndoName(SendMessage(Handle, EM_GETUNDONAME, 0, 0));
  3917. end;
  3918.  
  3919. function TRxCustomRichEdit.GetSelectionType: TRichSelectionType;
  3920. const
  3921.   SelTypes: array[TRichSelection] of Integer = (
  3922.     SEL_TEXT, SEL_OBJECT, SEL_MULTICHAR, SEL_MULTIOBJECT);
  3923. var
  3924.   Selection: Integer;
  3925.   I: TRichSelection;
  3926. begin
  3927.   Result := [];
  3928.   if HandleAllocated then begin
  3929.     Selection := SendMessage(Handle, EM_SELECTIONTYPE, 0, 0);
  3930.     for I := Low(TRichSelection) to High(TRichSelection) do
  3931.       if SelTypes[I] and Selection <> 0 then Include(Result, I);
  3932.   end;
  3933. end;
  3934.  
  3935. function TRxCustomRichEdit.GetSelection: TCharRange;
  3936. begin
  3937.   SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Result));
  3938. end;
  3939.  
  3940. procedure TRxCustomRichEdit.SetSelection(StartPos, EndPos: Longint;
  3941.   ScrollCaret: Boolean);
  3942. var
  3943.   CharRange: TCharRange;
  3944. begin
  3945.   with CharRange do begin
  3946.     cpMin := StartPos;
  3947.     cpMax := EndPos;
  3948.   end;
  3949.   SendMessage(Handle, EM_EXSETSEL, 0, Longint(@CharRange));
  3950.   if ScrollCaret then SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  3951. end;
  3952.  
  3953. {$IFDEF RX_D3}
  3954. procedure TRxCustomRichEdit.SetSelLength(Value: Integer);
  3955. begin
  3956.   with GetSelection do SetSelection(cpMin, cpMin + Value, True);
  3957. end;
  3958.  
  3959. procedure TRxCustomRichEdit.SetSelStart(Value: Integer);
  3960. begin
  3961.   SetSelection(Value, Value, False);
  3962. end;
  3963. {$ENDIF RX_D3}
  3964.  
  3965. function TRxCustomRichEdit.GetCharPos(CharIndex: Integer): TPoint;
  3966. var
  3967.   Res: Longint;
  3968. begin
  3969.   FillChar(Result, SizeOf(Result), 0);
  3970.   if HandleAllocated then begin
  3971.     if RichEditVersion = 2 then begin
  3972.       Res := SendMessage(Handle, Messages.EM_POSFROMCHAR, CharIndex, 0);
  3973.       Result.X := LoWord(Res);
  3974.       Result.Y := HiWord(Res);
  3975.     end
  3976.     else { RichEdit 1.0 and 3.0 }
  3977.       SendMessage(Handle, Messages.EM_POSFROMCHAR, WPARAM(@Result), CharIndex);
  3978.   end;
  3979. end;
  3980.  
  3981. function TRxCustomRichEdit.GetTextRange(StartPos, EndPos: Longint): string;
  3982. var
  3983.   TextRange: TTextRange;
  3984. begin
  3985.   SetLength(Result, EndPos - StartPos + 1);
  3986.   TextRange.chrg.cpMin := StartPos;
  3987.   TextRange.chrg.cpMax := EndPos;
  3988.   TextRange.lpstrText := PAnsiChar(Result);
  3989.   SetLength(Result, SendMessage(Handle, EM_GETTEXTRANGE, 0, Longint(@TextRange)));
  3990. end;
  3991.  
  3992. function TRxCustomRichEdit.WordAtCursor: string;
  3993. var
  3994.   Range: TCharRange;
  3995. begin
  3996.   Result := '';
  3997.   if HandleAllocated then begin
  3998.     Range.cpMax := SelStart;
  3999.     if Range.cpMax = 0 then Range.cpMin := 0
  4000.     else if SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMax) <> 0 then
  4001.       Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_MOVEWORDLEFT, Range.cpMax)
  4002.     else
  4003.       Range.cpMin := SendMessage(Handle, EM_FINDWORDBREAK, WB_LEFT, Range.cpMax);
  4004.     while SendMessage(Handle, EM_FINDWORDBREAK, WB_ISDELIMITER, Range.cpMin) <> 0 do
  4005.       Inc(Range.cpMin);
  4006.     Range.cpMax := SendMessage(Handle, EM_FINDWORDBREAK, WB_RIGHTBREAK, Range.cpMax);
  4007.     Result := Trim(GetTextRange(Range.cpMin, Range.cpMax));
  4008.   end;
  4009. end;
  4010.  
  4011. function TRxCustomRichEdit.LineFromChar(CharIndex: Integer): Integer;
  4012. begin
  4013.   Result := SendMessage(Handle, EM_EXLINEFROMCHAR, 0, CharIndex);
  4014. end;
  4015.  
  4016. function TRxCustomRichEdit.GetLineIndex(LineNo: Integer): Integer;
  4017. begin
  4018.   Result := SendMessage(Handle, EM_LINEINDEX, LineNo, 0);
  4019. end;
  4020.  
  4021. function TRxCustomRichEdit.GetLineLength(CharIndex: Integer): Integer;
  4022. begin
  4023.   Result := SendMessage(Handle, EM_LINELENGTH, CharIndex, 0);
  4024. end;
  4025.  
  4026. procedure TRxCustomRichEdit.SetUndoLimit(Value: Integer);
  4027. begin
  4028.   if (Value <> FUndoLimit) then begin
  4029.     FUndoLimit := Value;
  4030.     if (RichEditVersion >= 2) and HandleAllocated then
  4031.       FUndoLimit := SendMessage(Handle, EM_SETUNDOLIMIT, Value, 0);
  4032.   end;
  4033. end;
  4034.  
  4035. procedure TRxCustomRichEdit.SetDefAttributes(Value: TRxTextAttributes);
  4036. begin
  4037.   FDefAttributes.Assign(Value);
  4038. end;
  4039.  
  4040. procedure TRxCustomRichEdit.SetWordAttributes(Value: TRxTextAttributes);
  4041. begin
  4042.   FWordAttributes.Assign(Value);
  4043. end;
  4044.  
  4045. function TRxCustomRichEdit.GetStreamFormat: TRichStreamFormat;
  4046. begin
  4047.   Result := TRichEditStrings(Lines).Format;
  4048. end;
  4049.  
  4050. function TRxCustomRichEdit.GetStreamMode: TRichStreamModes;
  4051. begin
  4052.   Result := TRichEditStrings(Lines).Mode;
  4053. end;
  4054.  
  4055. procedure TRxCustomRichEdit.SetStreamFormat(Value: TRichStreamFormat);
  4056. begin
  4057.   TRichEditStrings(Lines).Format := Value;
  4058. end;
  4059.  
  4060. procedure TRxCustomRichEdit.SetStreamMode(Value: TRichStreamModes);
  4061. begin
  4062.   TRichEditStrings(Lines).Mode := Value;
  4063. end;
  4064.  
  4065. procedure TRxCustomRichEdit.SetPlainText(Value: Boolean);
  4066. var
  4067.   MemStream: TStream;
  4068.   StreamFmt: TRichStreamFormat;
  4069.   Mode: TRichStreamModes;
  4070. begin
  4071.   if PlainText <> Value then begin
  4072.     if HandleAllocated and (RichEditVersion >= 2) then begin
  4073.       MemStream := TMemoryStream.Create;
  4074.       try
  4075.         StreamFmt := TRichEditStrings(Lines).Format;
  4076.         Mode := TRichEditStrings(Lines).Mode;
  4077.         try
  4078.           if (csDesigning in ComponentState) or Value then
  4079.             TRichEditStrings(Lines).Format := sfPlainText
  4080.           else TRichEditStrings(Lines).Format := sfRichText;
  4081.           TRichEditStrings(Lines).Mode := [];
  4082.           Lines.SaveToStream(MemStream);
  4083.           MemStream.Position := 0;
  4084.           TRichEditStrings(Lines).EnableChange(False);
  4085.           try
  4086.             SendMessage(Handle, WM_SETTEXT, 0, 0);
  4087.             UpdateTextModes(Value);
  4088.             FPlainText := Value;
  4089.           finally
  4090.             TRichEditStrings(Lines).EnableChange(True);
  4091.           end;
  4092.           Lines.LoadFromStream(MemStream);
  4093.         finally
  4094.           TRichEditStrings(Lines).Format := StreamFmt;
  4095.           TRichEditStrings(Lines).Mode := Mode;
  4096.         end;
  4097.       finally
  4098.         MemStream.Free;
  4099.       end;
  4100.     end;
  4101.     FPlainText := Value;
  4102.   end;
  4103. end;
  4104.  
  4105. procedure TRxCustomRichEdit.UpdateTextModes(Plain: Boolean);
  4106. const
  4107.   TextModes: array[Boolean] of DWORD = (TM_RICHTEXT, TM_PLAINTEXT);
  4108.   UndoModes: array[Boolean] of DWORD = (TM_SINGLELEVELUNDO, TM_MULTILEVELUNDO);
  4109. begin
  4110.   if (RichEditVersion >= 2) and HandleAllocated then begin
  4111.     SendMessage(Handle, EM_SETTEXTMODE, TextModes[Plain] or
  4112.       UndoModes[FUndoLimit > 1], 0);
  4113.   end;
  4114. end;
  4115.  
  4116. procedure TRxCustomRichEdit.CMColorChanged(var Message: TMessage);
  4117. begin
  4118.   inherited;
  4119.   SendMessage(Handle, EM_SETBKGNDCOLOR, 0, ColorToRGB(Color))
  4120. end;
  4121.  
  4122. procedure TRxCustomRichEdit.EMReplaceSel(var Message: TMessage);
  4123. var
  4124.   CharRange: TCharRange;
  4125. begin
  4126.   Perform(EM_EXGETSEL, 0, Longint(@CharRange));
  4127.   with CharRange do
  4128.     cpMax := cpMin + Integer(StrLen(PChar(Message.lParam)));
  4129.   if (FUndoLimit > 1) and (RichEditVersion >= 2) and not FLinesUpdating then
  4130.     Message.wParam := 1; { allow Undo }
  4131.   inherited;
  4132.   if not FLinesUpdating then begin
  4133.     Perform(EM_EXSETSEL, 0, Longint(@CharRange));
  4134.     Perform(EM_SCROLLCARET, 0, 0);
  4135.   end;
  4136. end;
  4137.  
  4138. procedure TRxCustomRichEdit.SetRichEditStrings(Value: TStrings);
  4139. begin
  4140.   FRichEditStrings.Assign(Value);
  4141. end;
  4142.  
  4143. procedure TRxCustomRichEdit.CloseObjects;
  4144. var
  4145.   I: Integer;
  4146.   ReObject: TReObject;
  4147. begin
  4148.   if Assigned(FRichEditOle) then begin
  4149.     FillChar(ReObject, SizeOf(ReObject), 0);
  4150.     ReObject.cbStruct := SizeOf(ReObject);
  4151.     with IRichEditOle(FRichEditOle) do begin
  4152.       for I := GetObjectCount - 1 downto 0 do
  4153.         if Succeeded(GetObject(I, ReObject, REO_GETOBJ_POLEOBJ)) then begin
  4154.           if ReObject.dwFlags and REO_INPLACEACTIVE <> 0 then
  4155.             IRichEditOle(FRichEditOle).InPlaceDeactivate;
  4156.           ReObject.poleobj.Close(OLECLOSE_NOSAVE);
  4157.           ReleaseObject(ReObject.poleobj);
  4158.         end;
  4159.     end;
  4160.   end;
  4161. end;
  4162.  
  4163. function TRxCustomRichEdit.PasteSpecialDialog: Boolean;
  4164.  
  4165.   procedure SetPasteEntry(var Entry: TOleUIPasteEntry; Format: TClipFormat;
  4166.     tymed: DWORD; const FormatName, ResultText: string; Flags: DWORD);
  4167.   begin
  4168.     with Entry do begin
  4169.       fmtetc.cfFormat := Format;
  4170.       fmtetc.dwAspect := DVASPECT_CONTENT;
  4171.       fmtetc.lIndex := -1;
  4172.       fmtetc.tymed := tymed;
  4173.       if FormatName <> '' then lpstrFormatName := PChar(FormatName)
  4174.       else lpstrFormatName := '%s';
  4175.       if ResultText <> '' then lpstrResultText := PChar(ResultText)
  4176.       else lpstrResultText := '%s';
  4177.       dwFlags := Flags;
  4178.     end;
  4179.   end;
  4180.  
  4181. const
  4182.   PasteFormatCount = 6;
  4183. var
  4184.   Data: TOleUIPasteSpecial;
  4185.   PasteFormats: array[0..PasteFormatCount - 1] of TOleUIPasteEntry;
  4186.   Format: Integer;
  4187.   OleClientSite: IOleClientSite;
  4188.   Storage: IStorage;
  4189.   OleObject: IOleObject;
  4190.   ReObject: TReObject;
  4191.   Selection: TCharRange;
  4192. begin
  4193.   Result := False;
  4194.   if not CanPaste or not Assigned(FRichEditOle) then Exit;
  4195.   FillChar(Data, SizeOf(Data), 0);
  4196.   FillChar(PasteFormats, SizeOf(PasteFormats), 0);
  4197.   with Data do begin
  4198.     cbStruct := SizeOf(Data);
  4199.     hWndOwner := Handle;
  4200.     arrPasteEntries := @PasteFormats;
  4201.     cPasteEntries := PasteFormatCount;
  4202.     arrLinkTypes := @CFLinkSource;
  4203.     cLinkTypes := 1;
  4204.     dwFlags := PSF_SELECTPASTE;
  4205.   end;
  4206.   SetPasteEntry(PasteFormats[0], CFEmbeddedObject, TYMED_ISTORAGE, '', '',
  4207.     OLEUIPASTE_PASTE or OLEUIPASTE_ENABLEICON);
  4208.   SetPasteEntry(PasteFormats[1], CFLinkSource, TYMED_ISTREAM, '', '',
  4209.     OLEUIPASTE_LINKTYPE1 or OLEUIPASTE_ENABLEICON);
  4210.   SetPasteEntry(PasteFormats[2], CFRtf, TYMED_ISTORAGE,
  4211.     CF_RTF, CF_RTF, OLEUIPASTE_PASTE);
  4212.   SetPasteEntry(PasteFormats[3], CFRtfNoObjs, TYMED_ISTORAGE,
  4213.     CF_RTFNOOBJS, CF_RTFNOOBJS, OLEUIPASTE_PASTE);
  4214.   SetPasteEntry(PasteFormats[4], CF_TEXT, TYMED_HGLOBAL,
  4215.     'Unformatted text', 'text without any formatting', OLEUIPASTE_PASTE);
  4216.   SetPasteEntry(PasteFormats[5], CF_BITMAP, TYMED_GDI,
  4217.     'Windows Bitmap', 'bitmap image', OLEUIPASTE_PASTE);
  4218.   try
  4219.     if OleUIPasteSpecial(Data) = OLEUI_OK then begin
  4220.       Result := True;
  4221.       if Data.nSelectedIndex in [0, 1] then begin
  4222.         { CFEmbeddedObject, CFLinkSource }
  4223.         FillChar(ReObject, SizeOf(TReObject), 0);
  4224.         IRichEditOle(FRichEditOle).GetClientSite(OleClientSite);
  4225.         Storage := nil;
  4226.         try
  4227.           CreateStorage(Storage);
  4228.           case Data.nSelectedIndex of
  4229.             0: OleCheck(OleCreateFromData(Data.lpSrcDataObj,
  4230.                {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF},
  4231.                OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject));
  4232.             1: OleCheck(OleCreateLinkFromData(Data.lpSrcDataObj,
  4233.                {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF},
  4234.                OLERENDER_DRAW, nil, OleClientSite, Storage, OleObject));
  4235.           end;
  4236.           try
  4237.             with ReObject do begin
  4238.               cbStruct := SizeOf(TReObject);
  4239.               cp := REO_CP_SELECTION;
  4240.               poleobj := OleObject;
  4241.               OleObject.GetUserClassID(clsid);
  4242.               pstg := Storage;
  4243.               polesite := OleClientSite;
  4244.               dvAspect := DVASPECT_CONTENT;
  4245.               dwFlags := REO_RESIZABLE;
  4246.               OleCheck(OleSetDrawAspect(OleObject,
  4247.                 Data.dwFlags and PSF_CHECKDISPLAYASICON <> 0,
  4248.                 Data.hMetaPict, dvAspect));
  4249.             end;
  4250.             SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection));
  4251.             Selection.cpMax := Selection.cpMin + 1;
  4252.             OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject));
  4253.             SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection));
  4254.             IRichEditOle(FRichEditOle).SetDvaspect(
  4255.               Longint(REO_IOB_SELECTION), ReObject.dvAspect);
  4256.           finally
  4257.             ReleaseObject(OleObject);
  4258.           end;
  4259.         finally
  4260.           ReleaseObject(OleClientSite);
  4261.           ReleaseObject(Storage);
  4262.         end;
  4263.       end
  4264.       else begin
  4265.         Format := PasteFormats[Data.nSelectedIndex].fmtetc.cfFormat;
  4266.         OleCheck(IRichEditOle(FRichEditOle).ImportDataObject(
  4267.           Data.lpSrcDataObj, Format, Data.hMetaPict));
  4268.       end;
  4269.       SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  4270.     end;
  4271.   finally
  4272.     DestroyMetaPict(Data.hMetaPict);
  4273.     ReleaseObject(Data.lpSrcDataObj);
  4274.   end;
  4275. end;
  4276.  
  4277. function TRxCustomRichEdit.InsertObjectDialog: Boolean;
  4278. var
  4279.   Data: TOleUIInsertObject;
  4280.   NameBuffer: array[0..255] of Char;
  4281.   OleClientSite: IOleClientSite;
  4282.   Storage: IStorage;
  4283.   OleObject: IOleObject;
  4284.   ReObject: TReObject;
  4285.   IsNewObject: Boolean;
  4286.   Selection: TCharRange;
  4287. begin
  4288.   FillChar(Data, SizeOf(Data), 0);
  4289.   FillChar(NameBuffer, SizeOf(NameBuffer), 0);
  4290.   FillChar(ReObject, SizeOf(TReObject), 0);
  4291.   if Assigned(FRichEditOle) then begin
  4292.     IRichEditOle(FRichEditOle).GetClientSite(OleClientSite);
  4293.     Storage := nil;
  4294.     try
  4295.       CreateStorage(Storage);
  4296.       with Data do begin
  4297.         cbStruct := SizeOf(Data);
  4298.         dwFlags := IOF_SELECTCREATENEW or IOF_VERIFYSERVERSEXIST or 
  4299.           IOF_CREATENEWOBJECT or IOF_CREATEFILEOBJECT or IOF_CREATELINKOBJECT;
  4300.         hWndOwner := Handle;
  4301.         lpszFile := NameBuffer;
  4302.         cchFile := SizeOf(NameBuffer);
  4303.         iid := {$IFDEF RX_D3} IOleObject {$ELSE} IID_IOleObject {$ENDIF};
  4304.         oleRender := OLERENDER_DRAW;
  4305.         lpIOleClientSite := OleClientSite;
  4306.         lpIStorage := Storage;
  4307.         ppvObj := @OleObject;
  4308.       end;
  4309.       try
  4310.         Result := OleUIInsertObject(Data) = OLEUI_OK;
  4311.         if Result then
  4312.         try
  4313.           IsNewObject := Data.dwFlags and IOF_SELECTCREATENEW = IOF_SELECTCREATENEW;
  4314.           with ReObject do begin
  4315.             cbStruct := SizeOf(TReObject);
  4316.             cp := REO_CP_SELECTION;
  4317.             clsid := Data.clsid;
  4318.             poleobj := OleObject;
  4319.             pstg := Storage;
  4320.             polesite := OleClientSite;
  4321.             dvAspect := DVASPECT_CONTENT;
  4322.             dwFlags := REO_RESIZABLE;
  4323.             if IsNewObject then dwFlags := dwFlags or REO_BLANK;
  4324.             OleCheck(OleSetDrawAspect(OleObject,
  4325.               Data.dwFlags and IOF_CHECKDISPLAYASICON <> 0,
  4326.               Data.hMetaPict, dvAspect));
  4327.           end;
  4328.           SendMessage(Handle, EM_EXGETSEL, 0, Longint(@Selection));
  4329.           Selection.cpMax := Selection.cpMin + 1;
  4330.           OleCheck(IRichEditOle(FRichEditOle).InsertObject(ReObject));
  4331.           SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Selection));
  4332.           SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  4333.           IRichEditOle(FRichEditOle).SetDvaspect(
  4334.             Longint(REO_IOB_SELECTION), ReObject.dvAspect);
  4335.           if IsNewObject then OleObject.DoVerb(OLEIVERB_SHOW, nil,
  4336.             OleClientSite, 0, Handle, ClientRect);
  4337.         finally
  4338.           ReleaseObject(OleObject);
  4339.         end;
  4340.       finally
  4341.         DestroyMetaPict(Data.hMetaPict);
  4342.       end;
  4343.     finally
  4344.       ReleaseObject(OleClientSite);
  4345.       ReleaseObject(Storage);
  4346.     end;
  4347.   end
  4348.   else Result := False;
  4349. end;
  4350.  
  4351. function TRxCustomRichEdit.ObjectPropertiesDialog: Boolean;
  4352. var
  4353.   ObjectProps: TOleUIObjectProps;
  4354.   PropSheet: TPropSheetHeader;
  4355.   GeneralProps: TOleUIGnrlProps;
  4356.   ViewProps: TOleUIViewProps;
  4357.   LinkProps: TOleUILinkProps;
  4358.   DialogCaption: string;
  4359.   ReObject: TReObject;
  4360. begin
  4361.   Result := False;
  4362.   if not Assigned(FRichEditOle) or (SelectionType <> [stObject]) then Exit;
  4363.   FillChar(ObjectProps, SizeOf(ObjectProps), 0);
  4364.   FillChar(PropSheet, SizeOf(PropSheet), 0);
  4365.   FillChar(GeneralProps, SizeOf(GeneralProps), 0);
  4366.   FillChar(ViewProps, SizeOf(ViewProps), 0);
  4367.   FillChar(LinkProps, SizeOf(LinkProps), 0);
  4368.   FillChar(ReObject, SizeOf(ReObject), 0);
  4369.   ReObject.cbStruct := SizeOf(ReObject);
  4370.   if Succeeded(IRichEditOle(FRichEditOle).GetObject(Longint(REO_IOB_SELECTION),
  4371.     ReObject, REO_GETOBJ_POLEOBJ or REO_GETOBJ_POLESITE)) then
  4372.   try
  4373.     if ReObject.dwFlags and REO_INPLACEACTIVE = 0 then begin
  4374.       ObjectProps.cbStruct := SizeOf(ObjectProps);
  4375.       ObjectProps.dwFlags := OPF_DISABLECONVERT;
  4376.       ObjectProps.lpPS := @PropSheet;
  4377.       ObjectProps.lpObjInfo := TOleUIObjInfo.Create(Self, ReObject);
  4378.       if (ReObject.dwFlags and REO_LINK) <> 0 then begin
  4379.         ObjectProps.dwFlags := ObjectProps.dwFlags or OPF_OBJECTISLINK;
  4380.         ObjectProps.lpLinkInfo := TOleUILinkInfo.Create(Self, ReObject);
  4381.       end;
  4382.       ObjectProps.lpGP := @GeneralProps;
  4383.       ObjectProps.lpVP := @ViewProps;
  4384.       ObjectProps.lpLP := @LinkProps;
  4385.       PropSheet.dwSize := SizeOf(PropSheet);
  4386.       PropSheet.hWndParent := Handle;
  4387. {$IFDEF RX_D3}
  4388.       PropSheet.hInstance := MainInstance;
  4389. {$ELSE}
  4390.       PropSheet.hInstance := HInstance;
  4391. {$ENDIF}
  4392.       DialogCaption := Format(ResStr(SPropDlgCaption),
  4393.         [GetFullNameStr(ReObject.poleobj)]);
  4394.       PropSheet.pszCaption := PChar(DialogCaption);
  4395.       GeneralProps.cbStruct := SizeOf(GeneralProps);
  4396.       ViewProps.cbStruct := SizeOf(ViewProps);
  4397.       ViewProps.dwFlags := VPF_DISABLESCALE;
  4398.       LinkProps.cbStruct := SizeOf(LinkProps);
  4399.       LinkProps.dwFlags := ELF_DISABLECANCELLINK;
  4400.       Result := OleUIObjectProperties(ObjectProps) = OLEUI_OK;
  4401.     end;
  4402.   finally
  4403. {$IFNDEF RX_D3}
  4404.     ObjectProps.lpLinkInfo.Free;
  4405.     ObjectProps.lpObjInfo.Free;
  4406.     ReleaseObject(ReObject.polesite);
  4407.     ReleaseObject(ReObject.poleobj);
  4408. {$ENDIF}
  4409.   end;
  4410. end;
  4411.  
  4412. procedure TRxCustomRichEdit.Print(const Caption: string);
  4413. var
  4414.   Range: TFormatRange;
  4415.   LastChar, MaxLen, LogX, LogY, OldMap: Integer;
  4416.   SaveRect: TRect;
  4417.   TextLenEx: TGetTextLengthEx;
  4418. begin
  4419.   FillChar(Range, SizeOf(TFormatRange), 0);
  4420.   with Printer, Range do begin
  4421.     Title := Caption;
  4422.     BeginDoc;
  4423.     hdc := Handle;
  4424.     hdcTarget := hdc;
  4425.     LogX := GetDeviceCaps(Handle, LOGPIXELSX);
  4426.     LogY := GetDeviceCaps(Handle, LOGPIXELSY);
  4427.     if IsRectEmpty(PageRect) then begin
  4428.       rc.right := PageWidth * 1440 div LogX;
  4429.       rc.bottom := PageHeight * 1440 div LogY;
  4430.     end
  4431.     else begin
  4432.       rc.left := PageRect.Left * 1440 div LogX;
  4433.       rc.top := PageRect.Top * 1440 div LogY;
  4434.       rc.right := PageRect.Right * 1440 div LogX;
  4435.       rc.bottom := PageRect.Bottom * 1440 div LogY;
  4436.     end;
  4437.     rcPage := rc;
  4438.     SaveRect := rc;
  4439.     LastChar := 0;
  4440.     if RichEditVersion >= 2 then begin
  4441.       with TextLenEx do begin
  4442.         flags := GTL_DEFAULT;
  4443.         codepage := CP_ACP;
  4444.       end;
  4445.       MaxLen := Perform(EM_GETTEXTLENGTHEX, WParam(@TextLenEx), 0);
  4446.     end
  4447.     else MaxLen := GetTextLen;
  4448.     chrg.cpMax := -1;
  4449.     { ensure printer DC is in text map mode }
  4450.     OldMap := SetMapMode(hdc, MM_TEXT);
  4451.     SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);    { flush buffer }
  4452.     try
  4453.       repeat
  4454.         rc := SaveRect;
  4455.         chrg.cpMin := LastChar;
  4456.         LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
  4457.         if (LastChar < MaxLen) and (LastChar <> -1) then NewPage;
  4458.       until (LastChar >= MaxLen) or (LastChar = -1);
  4459.       EndDoc;
  4460.     finally
  4461.       SendMessage(Self.Handle, EM_FORMATRANGE, 0, 0);  { flush buffer }
  4462.       SetMapMode(hdc, OldMap);       { restore previous map mode }
  4463.     end;
  4464.   end;
  4465. end;
  4466.  
  4467. var
  4468.   Painting: Boolean = False;
  4469.  
  4470. procedure TRxCustomRichEdit.WMPaint(var Message: TWMPaint);
  4471. var
  4472.   R, R1: TRect;
  4473. begin
  4474.   if RichEditVersion >= 2 then
  4475.     inherited
  4476.   else begin
  4477.     if GetUpdateRect(Handle, R, True) then
  4478.     begin
  4479.       with ClientRect do R1 := Rect(Right - 3, Top, Right, Bottom);
  4480.       if IntersectRect(R, R, R1) then InvalidateRect(Handle, @R1, True);
  4481.     end;
  4482.     if Painting then
  4483.       Invalidate
  4484.     else begin
  4485.       Painting := True;
  4486.       try
  4487.         inherited;
  4488.       finally
  4489.         Painting := False;
  4490.       end;
  4491.     end;
  4492.   end;
  4493. end;
  4494.  
  4495. procedure TRxCustomRichEdit.WMDestroy(var Msg: TWMDestroy);
  4496. begin
  4497.   CloseObjects;
  4498.   ReleaseObject(FRichEditOle);
  4499.   inherited;
  4500. end;
  4501.  
  4502. procedure TRxCustomRichEdit.WMMouseMove(var Message: TMessage);
  4503. begin
  4504.   inherited;
  4505. end;
  4506.  
  4507. procedure TRxCustomRichEdit.WMSetCursor(var Message: TWMSetCursor);
  4508. begin
  4509.   inherited;
  4510. end;
  4511.  
  4512. {$IFDEF RX_D5}
  4513. procedure TRxCustomRichEdit.WMRButtonUp(var Message: TMessage);
  4514. begin
  4515.   { RichEd20 does not pass the WM_RBUTTONUP message to defwndproc, }
  4516.   { so we get no WM_CONTEXTMENU message. Simulate message here.    }
  4517.   if Win32MajorVersion < 5 then
  4518.     Perform(WM_CONTEXTMENU, Handle, LParam(PointToSmallPoint(
  4519.       ClientToScreen(SmallPointToPoint(TWMMouse(Message).Pos)))));
  4520.   inherited;
  4521. end;
  4522. {$ENDIF}
  4523.  
  4524. procedure TRxCustomRichEdit.CNNotify(var Message: TWMNotify);
  4525. var
  4526.   AMsg: TMessage;
  4527. begin
  4528.   with Message do
  4529.     case NMHdr^.code of
  4530.       EN_SELCHANGE: SelectionChange;
  4531.       EN_REQUESTRESIZE: RequestSize(PReqSize(NMHdr)^.rc);
  4532.       EN_SAVECLIPBOARD:
  4533.         with PENSaveClipboard(NMHdr)^ do
  4534.           if not SaveClipboard(cObjectCount, cch) then Result := 1;
  4535.       EN_PROTECTED:
  4536.         with PENProtected(NMHdr)^ do begin
  4537.           AMsg.Msg := Msg;
  4538.           AMsg.WParam := WParam;
  4539.           AMsg.LParam := LParam;
  4540.           AMsg.Result := 0;
  4541.           if not ProtectChange(AMsg, chrg.cpMin, chrg.cpMax) then
  4542.             Result := 1;
  4543.         end;
  4544.       EN_LINK:
  4545.         with PENLink(NMHdr)^ do begin
  4546.           case Msg of
  4547.             WM_RBUTTONDOWN:
  4548.               begin
  4549.                 FClickRange := chrg;
  4550.                 FClickBtn := mbRight;
  4551.               end;
  4552.             WM_RBUTTONUP:
  4553.               begin
  4554.                 if (FClickBtn = mbRight) and (FClickRange.cpMin = chrg.cpMin) and
  4555.                   (FClickRange.cpMax = chrg.cpMax) then
  4556.                   URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbRight);
  4557.                 with FClickRange do begin
  4558.                   cpMin := -1;
  4559.                   cpMax := -1;
  4560.                 end;
  4561.               end;
  4562.             WM_LBUTTONDOWN:
  4563.               begin
  4564.                 FClickRange := chrg;
  4565.                 FClickBtn := mbLeft;
  4566.               end;
  4567.             WM_LBUTTONUP:
  4568.               begin
  4569.                 if (FClickBtn = mbLeft) and (FClickRange.cpMin = chrg.cpMin) and
  4570.                   (FClickRange.cpMax = chrg.cpMax) then
  4571.                   URLClick(GetTextRange(chrg.cpMin, chrg.cpMax), mbLeft);
  4572.                 with FClickRange do begin
  4573.                   cpMin := -1;
  4574.                   cpMax := -1;
  4575.                 end;
  4576.               end;
  4577.           end;
  4578.         end;
  4579.       EN_STOPNOUNDO:
  4580.         begin
  4581.           { cannot allocate enough memory to maintain the undo state }
  4582.         end;
  4583.     end;
  4584. end;
  4585.  
  4586. function TRxCustomRichEdit.SaveClipboard(NumObj, NumChars: Integer): Boolean;
  4587. begin
  4588.   Result := True;
  4589.   if Assigned(OnSaveClipboard) then
  4590.     OnSaveClipboard(Self, NumObj, NumChars, Result);
  4591. end;
  4592.  
  4593. function TRxCustomRichEdit.ProtectChange(const Message: TMessage; StartPos,
  4594.   EndPos: Integer): Boolean;
  4595. begin
  4596.   Result := False;
  4597.   if Assigned(OnProtectChangeEx) then
  4598.     OnProtectChangeEx(Self, Message, StartPos, EndPos, Result)
  4599.   else if Assigned(OnProtectChange) then
  4600.     OnProtectChange(Self, StartPos, EndPos, Result);
  4601. end;
  4602.  
  4603. procedure TRxCustomRichEdit.SelectionChange;
  4604. begin
  4605.   if Assigned(OnSelectionChange) then OnSelectionChange(Self);
  4606. end;
  4607.  
  4608. procedure TRxCustomRichEdit.RequestSize(const Rect: TRect);
  4609. begin
  4610.   if Assigned(OnResizeRequest) then OnResizeRequest(Self, Rect);
  4611. end;
  4612.  
  4613. procedure TRxCustomRichEdit.URLClick(const URLText: string; Button: TMouseButton);
  4614. begin
  4615.   if Assigned(OnURLClick) then OnURLClick(Self, URLText, Button);
  4616. end;
  4617.  
  4618. function TRxCustomRichEdit.FindText(const SearchStr: string;
  4619.   StartPos, Length: Integer; Options: TRichSearchTypes): Integer;
  4620. var
  4621.   Find: TFindTextEx;
  4622.   Flags: Integer;
  4623. begin
  4624.   with Find.chrg do begin
  4625.     cpMin := StartPos;
  4626.     cpMax := cpMin + Abs(Length);
  4627.   end;
  4628.   if RichEditVersion >= 2 then begin
  4629.     if not (stBackward in Options) then Flags := FT_DOWN
  4630.     else Flags := 0;
  4631.   end
  4632.   else begin
  4633.     Options := Options - [stBackward];
  4634.     Flags := 0;
  4635.   end;
  4636.   if stWholeWord in Options then Flags := Flags or FT_WHOLEWORD;
  4637.   if stMatchCase in Options then Flags := Flags or FT_MATCHCASE;
  4638.   Find.lpstrText := PChar(SearchStr);
  4639.   Result := SendMessage(Handle, EM_FINDTEXTEX, Flags, Longint(@Find));
  4640.   if (Result >= 0) and (stSetSelection in Options) then begin
  4641.     SendMessage(Handle, EM_EXSETSEL, 0, Longint(@Find.chrgText));
  4642.     SendMessage(Handle, EM_SCROLLCARET, 0, 0);
  4643.   end;
  4644. end;
  4645.  
  4646. procedure TRxCustomRichEdit.ClearUndo;
  4647. begin
  4648.   SendMessage(Handle, EM_EMPTYUNDOBUFFER, 0, 0);
  4649. end;
  4650.  
  4651. procedure TRxCustomRichEdit.Redo;
  4652. begin
  4653.   SendMessage(Handle, EM_REDO, 0, 0);
  4654. end;
  4655.  
  4656. {$IFNDEF RX_V110}
  4657. procedure TRxCustomRichEdit.Undo;
  4658. begin
  4659.   SendMessage(Handle, WM_UNDO, 0, 0);
  4660. end;
  4661. {$ENDIF}
  4662.  
  4663. procedure TRxCustomRichEdit.StopGroupTyping;
  4664. begin
  4665.   if (RichEditVersion >= 2) and HandleAllocated then
  4666.     SendMessage(Handle, EM_STOPGROUPTYPING, 0, 0);
  4667. end;
  4668.  
  4669. {$IFDEF RX_D3}
  4670. procedure TRxCustomRichEdit.SetUIActive(Active: Boolean);
  4671. var
  4672.   Form: TCustomForm;
  4673. begin
  4674.   try
  4675.     Form := GetParentForm(Self);
  4676.     if Form <> nil then
  4677.       if Active then begin
  4678.         if (Form.ActiveOleControl <> nil) and
  4679.           (Form.ActiveOleControl <> Self) then
  4680.           Form.ActiveOleControl.Perform(CM_UIDEACTIVATE, 0, 0);
  4681.         Form.ActiveOleControl := Self;
  4682.         if AllowInPlace and CanFocus then SetFocus;
  4683.       end
  4684.       else begin
  4685.         if Form.ActiveOleControl = Self then Form.ActiveOleControl := nil;
  4686.         if (Form.ActiveControl = Self) and AllowInPlace then begin
  4687.           Windows.SetFocus(Handle);
  4688.           SelectionChange;
  4689.         end;
  4690.       end;
  4691.   except
  4692.     Application.HandleException(Self);
  4693.   end;
  4694. end;
  4695.  
  4696. procedure TRxCustomRichEdit.CMDocWindowActivate(var Message: TMessage);
  4697. begin
  4698.   if Assigned(FCallback) then
  4699.     with TRichEditOleCallback(FCallback) do
  4700.       if Assigned(FDocForm) and IsFormMDIChild(FDocForm.Form) then begin
  4701.         if Message.WParam = 0 then begin
  4702.           FFrameForm.SetMenu(0, 0, 0);
  4703.           FFrameForm.ClearBorderSpace;
  4704.         end;
  4705.       end;
  4706. end;
  4707.  
  4708. procedure TRxCustomRichEdit.CMUIDeactivate(var Message: TMessage);
  4709. begin
  4710.   if (GetParentForm(Self) <> nil) and Assigned(FRichEditOle) and
  4711.     (GetParentForm(Self).ActiveOleControl = Self) then
  4712.     {IRichEditOle(FRichEditOle).InPlaceDeactivate};
  4713. end;
  4714. {$ENDIF RX_D3}
  4715.  
  4716. { Find & Replace Dialogs }
  4717.  
  4718. procedure TRxCustomRichEdit.SetupFindDialog(Dialog: TFindDialog;
  4719.   const SearchStr, ReplaceStr: string);
  4720. begin
  4721.   with Dialog do begin
  4722.     if SearchStr <> '' then FindText := SearchStr;
  4723.     if RichEditVersion = 1 then
  4724.       Options := Options + [frHideUpDown, frDown];
  4725.     OnFind := FindDialogFind;
  4726. {$IFDEF RX_D3}
  4727.     OnClose := FindDialogClose;
  4728. {$ENDIF}
  4729.   end;
  4730.   if Dialog is TReplaceDialog then
  4731.     with TReplaceDialog(Dialog) do begin
  4732.       if ReplaceStr <> '' then ReplaceText := ReplaceStr;
  4733.       OnReplace := ReplaceDialogReplace;
  4734.     end;
  4735. end;
  4736.  
  4737. function TRxCustomRichEdit.FindDialog(const SearchStr: string): TFindDialog;
  4738. begin
  4739.   if FFindDialog = nil then begin
  4740.     FFindDialog := TFindDialog.Create(Self);
  4741.     if FReplaceDialog <> nil then
  4742.       FFindDialog.FindText := FReplaceDialog.FindText;
  4743.   end;
  4744.   Result := FFindDialog;
  4745.   SetupFindDialog(FFindDialog, SearchStr, '');
  4746.   FFindDialog.Execute;
  4747. end;
  4748.  
  4749. function TRxCustomRichEdit.ReplaceDialog(const SearchStr,
  4750.   ReplaceStr: string): TReplaceDialog;
  4751. begin
  4752.   if FReplaceDialog = nil then begin
  4753.     FReplaceDialog := TReplaceDialog.Create(Self);
  4754.     if FFindDialog <> nil then
  4755.       FReplaceDialog.FindText := FFindDialog.FindText;
  4756.   end;
  4757.   Result := FReplaceDialog;
  4758.   SetupFindDialog(FReplaceDialog, SearchStr, ReplaceStr);
  4759.   FReplaceDialog.Execute;
  4760. end;
  4761.  
  4762. function TRxCustomRichEdit.GetCanFindNext: Boolean;
  4763. begin
  4764.   Result := HandleAllocated and (FLastFind <> nil) and
  4765.     (FLastFind.FindText <> '');
  4766. end;
  4767.  
  4768. function TRxCustomRichEdit.FindNext: Boolean;
  4769. begin
  4770.   if CanFindNext then Result := FindEditText(FLastFind, False, True)
  4771.   else Result := False;
  4772. end;
  4773.  
  4774. procedure TRxCustomRichEdit.AdjustFindDialogPosition(Dialog: TFindDialog);
  4775. var
  4776.   TextRect, R: TRect;
  4777. begin
  4778.   if Dialog.Handle = 0 then Exit;
  4779.   with TextRect do begin
  4780.     TopLeft := ClientToScreen(GetCharPos(SelStart));
  4781.     BottomRight := ClientToScreen(GetCharPos(SelStart + SelLength));
  4782.     Inc(Bottom, 20);
  4783.   end;
  4784.   with Dialog do begin
  4785.     GetWindowRect(Handle, R);
  4786.     if PtInRect(R, TextRect.TopLeft) or PtInRect(R, TextRect.BottomRight) then
  4787.     begin
  4788.       if TextRect.Top > R.Bottom - R.Top + 20 then
  4789.         OffsetRect(R, 0, TextRect.Top - R.Bottom - 20)
  4790.       else begin
  4791.         if TextRect.Top + R.Bottom - R.Top < GetSystemMetrics(SM_CYSCREEN) then
  4792.           OffsetRect(R, 0, 40 + TextRect.Top - R.Top);
  4793.       end;
  4794.       Position := R.TopLeft;
  4795.     end;
  4796.   end;
  4797. end;
  4798.  
  4799. function TRxCustomRichEdit.FindEditText(Dialog: TFindDialog; AdjustPos, Events: Boolean): Boolean;
  4800. var
  4801.   Length, StartPos: Integer;
  4802.   SrchOptions: TRichSearchTypes;
  4803. begin
  4804.   with TFindDialog(Dialog) do begin
  4805.     SrchOptions := [stSetSelection];
  4806.     if frDown in Options then begin
  4807.       StartPos := Max(SelStart, SelStart + SelLength);
  4808.       Length := System.Length(Text) - StartPos + 1;
  4809.     end
  4810.     else begin
  4811.       SrchOptions := SrchOptions + [stBackward];
  4812.       StartPos := Min(SelStart, SelStart + SelLength);
  4813.       Length := StartPos + 1;
  4814.     end;
  4815.     if frMatchCase in Options then
  4816.       SrchOptions := SrchOptions + [stMatchCase];
  4817.     if frWholeWord in Options then
  4818.       SrchOptions := SrchOptions + [stWholeWord];
  4819.     Result := Self.FindText(FindText, StartPos, Length, SrchOptions) >= 0;
  4820.     if FindText <> '' then FLastFind := Dialog;
  4821.     if Result then begin
  4822.       if AdjustPos then AdjustFindDialogPosition(Dialog);
  4823.     end
  4824.     else if Events then TextNotFound(Dialog);
  4825.   end;
  4826. end;
  4827.  
  4828. procedure TRxCustomRichEdit.TextNotFound(Dialog: TFindDialog);
  4829. begin
  4830.   with Dialog do
  4831.     if Assigned(FOnTextNotFound) then FOnTextNotFound(Self, FindText);
  4832. end;
  4833.  
  4834. procedure TRxCustomRichEdit.FindDialogFind(Sender: TObject);
  4835. begin
  4836.   FindEditText(TFindDialog(Sender), True, True);
  4837. end;
  4838.  
  4839. procedure TRxCustomRichEdit.ReplaceDialogReplace(Sender: TObject);
  4840. var
  4841.   Cnt: Integer;
  4842.   SaveSelChange: TNotifyEvent;
  4843. begin
  4844.   with TReplaceDialog(Sender) do begin
  4845.     if (frReplaceAll in Options) then begin
  4846.       Cnt := 0;
  4847.       SaveSelChange := FOnSelChange;
  4848.       TRichEditStrings(Lines).EnableChange(False);
  4849.       try
  4850.         FOnSelChange := nil;
  4851.         while FindEditText(TFindDialog(Sender), False, False) do begin
  4852.           SelText := ReplaceText;
  4853.           Inc(Cnt);
  4854.         end;
  4855.         if Cnt = 0 then TextNotFound(TFindDialog(Sender))
  4856.         else AdjustFindDialogPosition(TFindDialog(Sender));
  4857.       finally
  4858.         TRichEditStrings(Lines).EnableChange(True);
  4859.         FOnSelChange := SaveSelChange;
  4860.         if Cnt > 0 then begin
  4861.           Change;
  4862.           SelectionChange;
  4863.         end;
  4864.       end;
  4865.     end
  4866.     else if (frReplace in Options) then begin
  4867.       if FindEditText(TFindDialog(Sender), True, True) then
  4868.         SelText := ReplaceText;
  4869.     end;
  4870.   end;
  4871. end;
  4872.  
  4873. {$IFDEF RX_D3}
  4874. procedure TRxCustomRichEdit.FindDialogClose(Sender: TObject);
  4875. begin
  4876.   CloseFindDialog(Sender as TFindDialog);
  4877. end;
  4878.  
  4879. procedure TRxCustomRichEdit.CloseFindDialog(Dialog: TFindDialog);
  4880. begin
  4881.   if Assigned(FOnCloseFindDialog) then FOnCloseFindDialog(Self, Dialog);
  4882. end;
  4883. {$ENDIF RX_D3}
  4884.  
  4885. { Conversion formats }
  4886.  
  4887. procedure AppendConversionFormat(const Ext: string; Plain: Boolean;
  4888.   AClass: TConversionClass);
  4889. var
  4890.   NewRec: PRichConversionFormat;
  4891. begin
  4892.   New(NewRec);
  4893.   with NewRec^ do begin
  4894. {$IFNDEF VER90}
  4895.     Extension := AnsiLowerCaseFileName(Ext);
  4896. {$ELSE}
  4897.     Extension := LowerCase(Ext);
  4898. {$ENDIF}
  4899.     PlainText := Plain;
  4900.     ConversionClass := AClass;
  4901.     Next := ConversionFormatList;
  4902.   end;
  4903.   ConversionFormatList := NewRec;
  4904. end;
  4905.  
  4906. class procedure TRxCustomRichEdit.RegisterConversionFormat(const AExtension: string;
  4907.   APlainText: Boolean; AConversionClass: TConversionClass);
  4908. begin
  4909.   AppendConversionFormat(AExtension, APlainText, AConversionClass);
  4910. end;
  4911.  
  4912. { Initialization part }
  4913.  
  4914. var
  4915.   OldError: Longint;
  4916.   FLibHandle: THandle;
  4917.   Ver: TOsVersionInfo;
  4918.  
  4919. initialization
  4920.   RichEditVersion := 1;
  4921.   OldError := SetErrorMode(SEM_NOOPENFILEERRORBOX);
  4922.   try
  4923. {$IFNDEF RICHEDIT_VER_10}
  4924.     FLibHandle := LoadLibrary(RichEdit20ModuleName);
  4925.     if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0;
  4926. {$ELSE}
  4927.     FLibHandle := 0;
  4928. {$ENDIF}
  4929.     if FLibHandle = 0 then begin
  4930.       FLibHandle := LoadLibrary(RichEdit10ModuleName);
  4931.       if (FLibHandle > 0) and (FLibHandle < HINSTANCE_ERROR) then FLibHandle := 0;
  4932.     end
  4933.     else begin
  4934.       RichEditVersion := 2;
  4935.       Ver.dwOSVersionInfoSize := SizeOf(Ver);
  4936.       GetVersionEx(Ver);
  4937.       with Ver do begin
  4938.         if (dwPlatformId = VER_PLATFORM_WIN32_NT) and
  4939.           (dwMajorVersion >= 5) then
  4940.           RichEditVersion := 3;
  4941.       end;
  4942.     end;
  4943.   finally
  4944.     SetErrorMode(OldError);
  4945.   end;
  4946.   CFEmbeddedObject := RegisterClipboardFormat(CF_EMBEDDEDOBJECT);
  4947.   CFLinkSource := RegisterClipboardFormat(CF_LINKSOURCE);
  4948.   CFRtf := RegisterClipboardFormat(CF_RTF);
  4949.   CFRtfNoObjs := RegisterClipboardFormat(CF_RTFNOOBJS);
  4950. finalization
  4951.   if FLibHandle <> 0 then FreeLibrary(FLibHandle);
  4952. end.
  4953.